Hallo VBA-Forum,
ich habe ein Problem mit dem Auswerten zweier Tabellen.
Die erste Tabelle hat 8000 Datensätze, die zweite Tabelle in etwa auch. Nun möchte ich gerne nach einem Wert aus Tabelle 1 in Tabelle 2 Suchen, und dann in Tabelle 2 farbig markieren. Es soll so laufen, daß die einzelnen Zellen innerhalb der Zeile dann markiert werden.
Bislang habe ich folgendes Zusammengeschnipselt:
[code]Sub Tabellen_vergleichen()
Dim verg1(7200, 30), verg2(7200, 30), mer(7200), titel(30)
'Tabelle 1 einlesen
Worksheets("Tabelle1").Activate
y = 1
Do While Cells(1, y) <> ""
titel(y) = Cells(1, y)
y = y + 1
Loop
For r = 1 To y - 1
z = 1
Do While Cells(z, 1) <> ""
verg1(z, r) = Cells(z, r)
z = z + 1
Loop
Next r
'Tabelle 2 einlesen
Worksheets("Tabelle2").Activate
yy = 1
Do While Cells(1, yy) <> ""
yy = yy + 1
Loop
For r = 1 To yy - 1
z = 1
Do While Cells(z, 1) <> ""
verg2(z, r) = Cells(z, r)
z = z + 1
Loop
Next r
'Änderungen kennzeichnen
For r = 1 To z - 1
For s = 1 To yy - 1
If verg1(r, s) <> verg2(r, s) Then
mer(r) = r
Cells(r, s).Select
With Selection.Interior
.ColorIndex = 6
.Pattern = xlSolid
End With
Selection.Interior.ColorIndex = 3
End If
Next s
Next r
Worksheets("Tabelle3").Activate
For l = 1 To yy - 1
Cells(1, l) = titel(l)
Next l
zz = 2
For m = 1 To z - 1
If m = mer(m) Then
For n = 1 To yy - 1
Cells(zz, n) = verg2(m, n)
Next n
zz = zz + 1
End If
Next m
End Sub
[/code]
Dabei ist es allerdings so, wenn in tabelle 2 die zeilen evtl nicht mehr exakt wie in der tabelle 1 sind, also zelle A64 aus Tabelle 1 nicht gleich zelle A64 Tabelle 2 ist, markiert Excel alle folgenden Zeilen als nicht gleich/falsch.
Hier ein anderes Script, welches Werte innerhalb einer Spalte zweier Tabellen vergleicht und unabhängig von der Zeilennummer korrekt ausführt. Das Skript markiert auch die gleichen Werte in Tabelle 2. Hier der Code
[code]Sub Tabellen_Vergleichen1()
Dim LoI As Long ' 1. Schleifenvariable
Dim LoJ As Long ' 2. Schleifenvariable
Dim LoLetzte1 As Long ' letzte Zeile in Spalte A
Dim LoLetzte2 As Long ' letzte Zeile in Spalte B
With Worksheets("Tabelle1")
' unabhängig von Excelversion für Spalte A (1)
LoLetzte1 = IIf(IsEmpty(.Cells(Rows.Count, 1)), .Cells(Rows.Count, 1).End(xlUp).Row, Rows.Count)
End With
With Worksheets("Tabelle2")
LoLetzte2 = IIf(IsEmpty(.Cells(Rows.Count, 1)), .Cells(Rows.Count, 1).End(xlUp).Row, Rows.Count)
End With
For LoI = 1 To LoLetzte1 ' 1. Schleife alle Werte Spalte A
For LoJ = 1 To LoLetzte2 ' 2. Schleife alle Werte Spalte B
If Worksheets("Tabelle1").Cells(LoI, 1) <> "" Then ' Leerzellen nicht kennzeichnen
If Worksheets("Tabelle1").Cells(LoI, 1) = Worksheets("Tabelle2").Cells(LoJ, 1) Then
Worksheets("Tabelle2").Cells(LoJ, 1).Interior.ColorIndex = 6
End If
End If
Next LoJ
Next LoI
End Sub[/code]
Jetzt zu meiner Frage: Wie kann ich das so kombinieren, dass das erste Script in der Suchweise wie das zweite arbeitet? Dann würde ja alles super funktionieren, ich bekomme das aber nicht hin? Wer könnte mir helfen? |