Letzes zeichen in Spalte M oder V dann Zeilen löschen

[luna101]

Hallo Uwe,
das habe ich schon gemacht und es funktioniert auch.  Da aber die angehängten Name immer ändern,
werden z.B. M Klara oder V Martin ,  M Irene , V Johann usw. nicht ausgeblendet.
Gruss Martin

[Kuwer]

Hallo Martin,

teste mal das:

Sub CommandButton1_Click()

  Dim ob As Range

  Dim rng As Range, temp As Range

  Dim firstAddress As String

  Set rng = Range("C4").CurrentRegion.Resize(, 20).Offset(1)

  Set ob = rng.Find("M*", , LookIn:=xlValues, lookat:=xlWhole)

  If Not ob Is Nothing Then

    firstAddress = ob.Address

    Do

      ob.EntireRow.Cells(1).Resize(, ob.Column - 1) = ""

      If temp Is Nothing Then

        Set temp = ob

      Else

        Set temp = Application.Union(temp, ob)

      End If

      Set ob = rng.FindNext(ob)

    Loop While Not ob Is Nothing And ob.Address <> firstAddress

  End If

  Set ob = rng.Find("V*", , LookIn:=xlValues, lookat:=xlWhole)

  If Not ob Is Nothing Then

    firstAddress = ob.Address

    Do

      ob.EntireRow.Cells(1).Resize(, ob.Column - 1) = ""

      If temp Is Nothing Then

        Set temp = ob

      Else

        Set temp = Application.Union(temp, ob)

      End If

      Set ob = rng.FindNext(ob)

    Loop While Not ob Is Nothing And ob.Address <> firstAddress

  End If

  If Not temp Is Nothing Then

    temp.EntireRow.Hidden = True

  End If

End Sub

Gruß Uwe

[luna101]

Hallo Uwe,
bin am Verzweifeln.
Dein Makro mit den Daten der eingefügten Tabelle funktioniert.
Nun habe ich die Tabelle mit einigen Daten gefüllt und es läuft nicht mehr.
Es verhält sich wie eine nie endenden Schlaufe.
Habe nochmals die Tabelle mit neuen Daten hochgeladen.
Wo ist der Fehler. :92:
Gruss Martin

[Kuwer]

Hallo Martin,

wenn sich der Bereich ändert, muss das natürlich auch im Code angepasst werden.
Diese Zeile habe ich freigestellt und so umgeschrieben, dass sie leichter les- und änderbar ist.

  Sub CommandButton1_Click()

  Dim ob As Range

  Dim rng As Range, temp As Range

  Dim firstAddress As String

  Application.ScreenUpdating = False

  

  Set rng = Application.Intersect(Range("B6").CurrentRegion.Offset(1), Range("B:M"))

  

  Set ob = rng.Find("M*", , LookIn:=xlValues, lookat:=xlWhole)

  If Not ob Is Nothing Then

    firstAddress = ob.Address

    Do

      ob.EntireRow.Cells(1).Resize(, ob.Column - 1) = ""

      If temp Is Nothing Then

        Set temp = ob

      Else

        Set temp = Application.Union(temp, ob)

      End If

      Set ob = rng.FindNext(ob)

    Loop While Not ob Is Nothing And ob.Address <> firstAddress

  End If

  Set ob = rng.Find("V*", , LookIn:=xlValues, lookat:=xlWhole)

  If Not ob Is Nothing Then

    firstAddress = ob.Address

    Do

      ob.EntireRow.Cells(1).Resize(, ob.Column - 1) = ""

      If temp Is Nothing Then

        Set temp = ob

      Else

        Set temp = Application.Union(temp, ob)

      End If

      Set ob = rng.FindNext(ob)

    Loop While Not ob Is Nothing And ob.Address <> firstAddress

  End If

  If Not temp Is Nothing Then

    temp.EntireRow.Hidden = True

  End If

  Application.ScreenUpdating = True

End Sub

Gruß Uwe

[luna101]

Hallo Uwe,
danke für die Hilfe. Jetzt sehe ich auch, wo mein Fehler lag.
Jetzt funktioniert das Makro, wie ich es mir gewünscht habe.
:18: :18:
Mit dankbaren Grüssen
Martin