Frage zu Find-Befehl VBA
Beffen
Ich bastle derzeit an der Anpassung eines Codewerkes, das mir Franz hat zukommen lassen. Danke übrigens nochmal dafür!
Es handelt sich bei diesem Schnippsel um die Find-Funktion:
Set Zelle = wksQuelle.Columns(kpad).Find(what:=.Cells(Zeile, k).Value, lookat:=xlWhole, LookIn:=xlValues)
leider ist Zelle immer "nothing", weil er nichts findet. Das liegt wahrscheinlich an dem Syntax, den ich noch nicht ganz kapiere!
Grundsätzlich steht der Suchwert in den beiden Tabellen an unterschiedlicher Stelle. Ich interpretiere denCode so, dass
- wksQuelle.Columns(kpad) die Suchspalte kpad in der entfernten Tabelle darstellt (in dem Beispiel Spalte I=9)
- .Find(what:=.Cells(Zeile, k).Value den Vergleichswert in der aktuellen Tabelle in k-Spalte (k ist in dem Beispiel auch 9 - kann aber variieren - genauso wie kpad) für die Schleifenzeile "findet"
Ich komm irgendwie nicht mehr klar, denn die Anpassung gestaltet sich schwierig...
Sieht jemand durch das Kauderwelsch durch, dass ich da fabriziert habe?
Hier der Code im Zusammenhang. Ist eine Entwurfsfassung - also viel auskommentiert um den Fehler einzuschränken.
Sub holeMasterDaten()
'dateinameseparieren
Dim wbQuelle As Workbook, wksQuelle As Worksheet, Zeile_Q
Dim wbZiel As Workbook, wksZiel As Worksheet, Zeile, Zelle As Range
k = Sheets("system").Range("K3").Value
kpad = Sheets("system").Range("N3").Value
wertungvon = Sheets("system").Range("K8").Value
wertungbis = Sheets("system").Range("K9").Value
Set wbQuelle = ThisWorkbook 'Name ggf. anpassen
Set wksQuelle = wbQuelle.Worksheets("tempcoglopad") 'Name ggf. anpassen
Set wbZiel = ThisWorkbook 'Name ggf. anpassen
Set wksZiel = wbZiel.Worksheets("New LCL") 'Name ggf. anpassen
' Application.ScreenUpdating = False
With wksQuelle
'Letzte Zeile in PAD-Number-Spalte
Zeile_Q = .Cells(.Rows.Count, 4).End(xlUp).Row
'Datenzeilen kopieren
.Range(.Cells(4, 1), .Cells(Zeile_Q, 13)).Copy
End With
With wksZiel
'Werte in Zieltabelle einfügen
.Cells(8, 1).PasteSpecial Paste:=xlPasteValues
Set wksQuelle = wbQuelle.Worksheets("templcl") 'Name ggf. anpassen
'Zeilen in Zieltabelle nachbereiten
For Zeile = 8 To .Cells(.Rows.Count, 9).End(xlUp).Row
'Shop 7 Zeilen - Informationen löschen
'If .Cells(Zeile, k) = 3000012 Then
'Spalten B-C
' .Range(.Cells(Zeile, 1), .Cells(Zeile, 100)).ClearContents
'Spalten E
'.Cells(Zeile, 5).ClearContents
' End If
'Pad-Number in "templcl" suchen
Set Zelle = wksQuelle.Columns(kpad).Find(what:=.Cells(Zeile, k).Value, lookat:=xlWhole, _
LookIn:=xlValues)
If Zelle Is Nothing Then
'Zeile in Spalten wertungvon bis wertungbis färben und Inhalte löschen
With .Range(.Cells(Zeile, wertungvon), .Cells(Zeile, wertungbis))
.Interior.ColorIndex = 8 'gelb
'.ClearContents
End With
Else
Zeile_Q = Zelle.Row
'Werte aus Spalten F bis I von "LCL alt" nach "LCL neu" kopieren
With wksQuelle
.Range(.Cells(Zeile_Q, wertungvon), .Cells(Zeile_Q, wertungbis)).Copy
End With
With .Range(.Cells(Zeile, wertungvon), .Cells(Zeile, wertungbis))
.PasteSpecial Paste:=xlPasteValues
.Interior.ColorIndex = xlColorIndexNone
End With
End If
Set Zelle = Nothing
Next
Application.CutCopyMode = False
End With
Application.ScreenUpdating = True
End Sub
Danke
Gruß Uwe