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
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
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
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
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