23.03.2021, 15:41
23.03.2021, 15:55
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?
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?
23.03.2021, 16:00
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
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
23.03.2021, 16:17
Hallo,
teste mal
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 Sub23.03.2021, 17:15
das funktioniert perfekt. Vielen Dank 