mit VBA Zellen löschen

[Enclave]

Ja der kommt da doppelt vor mit unterschiedlichen Vornamen

[Steffl]

Hallo,

das Spohn 2 mal drin ist, habe ich gesehen, einmal als Spohn J und einmal als Spohn I. Was ich aber wissen will, gibt es in der Realität den Spohn J zweimal in der Tabelle Recherche?

[Enclave]

Edit:

Spohn J gibt es einmal in der REcherche und Spohn I gibt es.

es gibt aber nicht Spohn J zweimal.

Sorry das hatte ich falsch verstanden

[Steffl]

Hallo,

teste mal

Code:

Sub prcX()
   Dim x, rSuchErgebnis As Range
   Dim I As Long
   Dim rDaten As Range
   Dim strFirstTreffer As String
   Dim strSuchString As String
   Dim rngLöschBereich As Range
        
   Application.ScreenUpdating = False
  
   With Worksheets("Zahlen zählen")
      
      Set rDaten = Range("TabelleRecherche")
      For I = rDaten.Rows.Count To 1 Step -1  ' Range("TabelleRecherche").Resize(Range("TabelleRecherche").Rows.Count, 1)
      
      If LCase(rDaten.Cells(I, 1).Value) = "x" Then
         strSuchString = rDaten.Cells(I, 3).Value & rDaten.Cells(I, 4).Value
        
         Set rSuchErgebnis = .Range("A4:A" & .Cells(Rows.Count, "A").End(xlUp).Row).Find(what:=rDaten.Cells(I, 3).Value, LookIn:=xlValues, Lookat:=xlWhole)
         If Not rSuchErgebnis Is Nothing Then
               strFirstTreffer = rSuchErgebnis.Address
               'namen vergleichen auch wenns ne fast direkte referenz ist
               Do
               If strSuchString = rSuchErgebnis.Value & rSuchErgebnis.Offset(0, 1).Value Then
                  If rngLöschBereich Is Nothing Then
                     Set rngLöschBereich = rSuchErgebnis.Resize(1, 5)
                  Else
                     Set rngLöschBereich = Union(rSuchErgebnis.Resize(1, 5), rngLöschBereich)
                  End If
'                  rSuchErgebnis.Resize(1, 5).ClearContents 'Delete xlShiftUp 'zeile löschen
                  rDaten.Cells(I, 1).ClearContents  'x entfernen
               End If
               Set rSuchErgebnis = .Range("A4:A" & .Cells(Rows.Count, "A").End(xlUp).Row).FindNext(rSuchErgebnis)
               Loop While strFirstTreffer <> rSuchErgebnis.Address
         End If
      End If
      
      Next
      rngLöschBereich.ClearContents
      
   End With
  
End Sub

[Enclave]

das funktioniert perfekt. Vielen Dank