Wert aus Zelle mit Wert in anderer vergleichen
20.11.2018 15:36:04
Anna
ich versuche einen Wert einer Zelle (Var1) mit einem anderen Wert einer Zelle (aktZelle.Value) zu verlgeichen. Klappt soweit ganz gut. Jedoch befinden sich manchmal mehr Strings in aktZelle.Value sodass Var1 das nicht als Vergleich annimmt und einfach weitergeht.
Bsp:
var1 = s12345, aktZelle.Value = s12345 --> match
var1 = s12346, aktZelle.Value = s12345 s12346 s12348 s12349 --> kein Match
Mit "Like" sollte doch var1 als Teilstring von aktZelle.Value erkannt werden, oder?
Die werte in aktZelle sind durch ein Leerzeichen getrennt. Jemand vielleicht noch eine Idee?
Sub befuelleTab()
Dim Var1 As Variant, Var2 As Variant
Dim letzteZeile As String, letzteZeileDtl As String, freieZeileTab As String
Dim c As Range, tt As Range, zelle As Range, aktzelle As Range
Dim aktzeile As Long
With Worksheets("Namensliste")
letzteZeile = .Cells(Rows.Count, 2).End(xlUp).Row
For Each zelle In .Range("B2:B" & letzteZeile)
On Error Resume Next
If Not IsEmpty(zelle) Then
Var1 = Sheets("Namensliste").Range("A" & zelle.Row).Value
With Worksheets("Details")
.Rows("1:1").Autofilter _
_
letzteZeileDtl = .Cells(Rows.Count, 1).End(xlUp).Row
.Range("$A$1:$T" & letzteZeileDtl).Autofilter Field:=12, Criteria1:=Var1 _
_
'Filtern des Sheets
.Range("$A$1:$T" & letzteZeileSoMa).Autofilter Field:=4, Criteria1:=Var2
letzteZeileDtl = .Cells(Rows.Count, 1).End(xlUp).Row For Each _
aktzelle In .Range("F2:F" & letzteZeileDtl)
On Error Resume Next
If Var1 Like aktzelle.Value Then
freieZeileTab = Worksheets("Details").Cells(Rows.Count, 1).End(xlUp). _
Row
Set c = Sheets("Details").Range("N" & aktzelle.Row)
Set tt = Sheets("Namensliste").Cells(zelle.Row, 5)
c.Copy Destination:=tt
End If
Next aktzelle
End With
End If
Next zelle
End With
End Sub