Abänderung
23.07.2008 08:47:12
Günter
Guten Morgen (übrigens - super Forum!!),
habe im Forum folgendes gefunden:
-hier werden 2 Tabellenblätter ab A2 verglichen und identische
in ein 3. Arbeitsblatt kopiert- Hierbei wird nur die betreffende Zelle in das
3. Arbeitsblatt kopiert. Habe ganzes Makro hier aufgeführt.
Frage: Wer kann mit helfen, das Makro so umschreiben, dass die ganze Zeile (A-P) auf das 3. Arbeitsblatt kopiert wird?
Private Sub CmdVergleichen_Click()
' Derzeit sitze ich vor 2 Tabellen mit teilweise identischen und
' teilweise unterschiedlichen Ordernummern. Ich möchte gerne einen
' Datenabgleich beider Tabellen durchführen, wobei das Merkmal beider
' Tabellen eine übereinstimmende Odernummer sein soll. Die Überein-
' stimmenden Datensätze mit gleicher Ordernummer in beiden Spalten
' möchte ich entweder optisch markiert oder in einer neuen Tabelle
' ausgefiltert haben.
Dim var As Variant
Dim iRow As Integer, iRowT As Integer
'Zaehler auf die Zeile setzen in dem die ersten Daten stehen.
iRow = 2
iRowT = 2
'Vergleichen von Trade 1 zu Trade 2 und gleiche Zellen in Ergebnis rüberkopieren
Do Until IsEmpty(Worksheets("Trade 1").Cells(iRow, 1))
var = Application.Match(Worksheets("Trade 1").Cells(iRow, 1), Worksheets("Trade 2"). _
Columns(1), 0)
If Not IsError(var) Then
Worksheets("Ergebnis").Cells(iRowT, 1) = Worksheets("Trade 1").Cells(iRow, 1)
iRowT = iRowT + 1
Else
'Fehlende Zellen die in Trade 1 vorhanden sind, aber nicht in Trade 2 farblich markieren.
Worksheets("Trade 1").Cells(iRow, 1).Interior.ColorIndex = 6
End If
iRow = iRow + 1
Loop
'Vergleichen von Trade 2 zu Trade 1
iRow = 2
'Fehlende Zellen die in Trade 2 vorhanden sind, aber nicht in Trade 1 farblich markieren.
Do Until IsEmpty(Worksheets("Trade 2").Cells(iRow, 1))
var = Application.Match(Worksheets("Trade 2").Cells(iRow, 1), Worksheets("Trade 1"). _
Columns(1), 0)
If IsError(var) Then
Worksheets("Trade 2").Cells(iRow, 1).Interior.ColorIndex = 6
End If
iRow = iRow + 1
Loop
End Sub
Private Sub CmdZuruecksetzen_Click()
Dim iRow As Integer
iRow = 2
Do Until IsEmpty(Worksheets("Trade 1").Cells(iRow, 1))
Worksheets("Trade 1").Cells(iRow, 1).Interior.ColorIndex = 0
iRow = iRow + 1
Loop
iRow = 2
Do Until IsEmpty(Worksheets("Trade 2").Cells(iRow, 1))
Worksheets("Trade 2").Cells(iRow, 1).Interior.ColorIndex = 0
iRow = iRow + 1
Loop
iRow = 2
Do Until IsEmpty(Worksheets("Ergebnis").Cells(iRow, 1))
Worksheets("Ergebnis").Cells(iRow, 1).Value = Null
iRow = iRow + 1
Loop
End Sub
Anzeige