Tabellen vergleich
10.03.2004 11:47:53
Viper
mein prob liegt darin das ich 2 tabellen mit in Spalte 1 stehender Zahl habe wobei in beiden tabellen unterschiedliche, andere und gleiche Zahlen stehen.Ich brauch aber nur die gleichen und zu allem übel sind in Tabelle2 weitere spalten zu übernehmen. Hab da mal was getestet funtz aber nicht richtig.Laut Code müßte in der ersten und der letzten Zeile der Gleiche wert stehen macht er aber nicht es stehen andere Zahlen drin
Kann mir dabei einer helfen???????
Gruß dirk
Sub Vergleichen1()
Dim vRow As Variant
Dim lRow As Long, lRowT As Long
Dim bln As Boolean
bln = Application.DisplayStatusBar
Application.DisplayStatusBar = True
lRow = 1
Do Until IsEmpty(Cells(lRow, 1))
vRow = Application.Match(Cells(lRow, 1).Value, Worksheets("Tabelle1").Columns(1), 0)
If Not IsError(vRow) Then
lRowT = lRowT + 1
Worksheets("Tabelle3").Cells(lRowT, 1).Value = Worksheets("Tabelle1").Cells(lRow, 1).Value
Worksheets("Tabelle3").Cells(lRowT, 2).Value = Worksheets("Tabelle2").Cells(vRow, 14).Value
Worksheets("Tabelle3").Cells(lRowT, 3).Value = Worksheets("Tabelle2").Cells(vRow, 11).Value
Worksheets("Tabelle3").Cells(lRowT, 4).Value = Worksheets("Tabelle2").Cells(vRow, 12).Value
Worksheets("Tabelle3").Cells(lRowT, 5).Value = Worksheets("Tabelle2").Cells(vRow, 8).Value
Worksheets("Tabelle3").Cells(lRowT, 6).Value = Worksheets("Tabelle2").Cells(vRow, 9).Value
Worksheets("Tabelle3").Cells(lRowT, 7).Value = Worksheets("Tabelle2").Cells(vRow, 10).Value
Worksheets("Tabelle3").Cells(lRowT, 8).Value = Worksheets("Tabelle2").Cells(vRow, 4).Value
Worksheets("Tabelle3").Cells(lRowT, 9).Value = Worksheets("Tabelle2").Cells(vRow, 5).Value
Worksheets("Tabelle3").Cells(lRowT, 10).Value = Worksheets("Tabelle2").Cells(lRow, 1).Value
End If
lRow = lRow + 1
Loop
Application.DisplayStatusBar = bln
Application.StatusBar = False
Worksheets("Tabelle3").Activate
End Sub