Tabellen vergleichen und Werte übertragen :-)
25.05.2007 11:51:00
Thomas
möchte mich heute auch mal mit einem Problem an euch wenden. Habe zwar schon diverse ähnliche Fragen und Antworten hier gefunden aber bekomme diese leider nicht für meinen Fall angepasst.
Ich habe 2 Tabellen. Tabelle1 heißt Neu, Tabelle2 heißt Suchen. Tabelle Neu besteht aus 17 Spalten und bisher 6000 Zeilen. Tabelle Suchen besteht aus 12 Spalten und bis ca. 50 Zeilen.
Aus Tabelle Suchen sollen die Werte der Spalte A mit den Werten der Spalte B in der Tabelle Neu verglichen werden. Bei Übereinstimmung soll in der Tabelle Neu Spalte M der Inhalt aus der Tabelle Suchen Spalte L eingetragen werden.
Habe folgende funktionierende Funktion gefunden und angepasst:
Sub Schaltfläche154_BeiKlick()
Dim rng As Range
Dim iRowL As Integer, iRow As Integer
iRowL = Cells(Rows.Count, 1).End(xlUp).Row
For iRow = 1 To iRowL
If Not IsEmpty(Cells(iRow, 1)) Then
With Worksheets("SUCHEN")
Set rng = .Cells.Find(Cells(iRow, 2), lookat:=xlWhole, LookIn:=xlValues)
If Not rng Is Nothing Then
Cells(iRow, 13) = .Cells(rng.Row, 12)
' Cells(iRow, 3) = .Cells(rng.Row, 3)
End If
End With
End If
Next iRow
End Sub
Nur hier dauert der Abgleich bis zu 4 Minuten. Das geht doch bestimmt schneller, Oder?
Danke für eure Hilfe!
Thomas
Anzeige