ich habe zwei Tabellen in einer Datei. Nun möchte ich Tabelle2 mit Tabelle1 vergleichen, die gleichen Zellen sollen markiert werden und außerdem in ein neues Arbeitsblatt „Auswertung“ kopiert werden. ich habe nun folgendes Makro probiert, dass aber leider nur die erste Spalte in Tabelle 1 vergleicht. Ich möchte aber, dass die erste Spalte in Tabelle2 mit den Spalten A,B,C in Tabelle1 verglichen wird. Kann mir jemand helfen? Ich bin blutige VBA Anfängerin.
Windows XP, Office 2003.
Danke im Voraus!
Birgit
Sub Daten_vergleichen()
Dim Suchname As String, Fundname As Range, letzte_Zeile_Tab1 As Long, _
letzte_Zeile_Tab2 As Long, Wiederholungen As Long, Addresse As String, _
gefundene_Zeile As Long
Application.ScreenUpdating = False
letzte_Zeile_Tab1 = Sheets(„Tabelle1“).Range(„A65536“).End(xlUp).Row
letzte_Zeile_Tab2 = Sheets(„Tabelle2“).Range(„A65536“).End(xlUp).Row
For Wiederholungen = 2 To letzte_Zeile_Tab1
Suchname = Sheets(„Tabelle1“).Cells(Wiederholungen, 1)
With Sheets(„Tabelle2“).Range(„A2:A“ & letzte_Zeile_Tab2)
Set Fundname = .Find(What:=Suchname, LookIn:=xlValues)
If Not Fundname Is Nothing Then
Addresse = Fundname.Address
gefundene_Zeile = Fundname.Row
Sheets(„Tabelle1“).Cells(Wiederholungen, 1).Interior.ColorIndex = 4
Sheets(„Tabelle2“).Cells(gefundene_Zeile, 1).Interior.ColorIndex = 4
Sheets(„Tabelle2“).Cells(gefundene_Zeile, 1).Copy
Sheets(„Auswertung“).Cells(Sheets(„Auswertung“).Range(„A65536“).End(xlUp). _
Offset(1, 0).Row, 1).PasteSpecial Paste:=xlValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Do
Set Fundname = .FindNext(Fundname)
Loop While Not Fundname Is Nothing And Fundname.Address Addresse
End If
End With
Next
End Sub
ich habe zwei Tabellen in einer Datei. Nun möchte ich Tabelle2
mit Tabelle1 vergleichen, die gleichen Zellen sollen markiert
werden und außerdem in ein neues Arbeitsblatt „Auswertung“
kopiert werden. ich habe nun folgendes Makro probiert, dass
aber leider nur die erste Spalte in Tabelle 1 vergleicht. Ich
möchte aber, dass die erste Spalte in Tabelle2 mit den Spalten
A,B,C in Tabelle1 verglichen wird. Kann mir jemand helfen? Ich
bin blutige VBA Anfängerin.
Hallo Birgit,
probiers mal so:
Sub Daten\_vergleichen()
Dim wks1 As Worksheet, wks2 As Worksheet, wksA As Worksheet
Dim Zei2 As Long, Such As Range
Set wks1 = Worksheets("Tabelle1")
Set wks2 = Worksheets("Tabelle2")
Set wksA = Worksheets("Auswertung")
With wks1
For Zei2 = 1 To wks2.Cells(Rows.Count, 1).End(xlUp).Row
Set Such = .Range("A:C").Find(wks2.Cells(Zei2, 1))
If Not Such Is Nothing Then
wksA.Cells(wksA.Cells(Rows.Count, 1).End(xlUp).Row + 1, 1) = wks2.Cells(Zei2, 1)
wks2.Cells(Zei2, 1).Interior.ColorIndex = 4
.Range(Such.Address).Interior.ColorIndex = 4
End If
Next Zei2
End With
End Sub
Tabellen vergleichen-mehrere Spalten-nicht ganz
Hallo Reinhard,
vielen Dank für Deine Hilfe. Leider funktioniert das Makro noch nicht ganz. Was funktioniert ist: die doppelten aus Tabelle2 werden markiert und in Auswertung geschoben. In den Spalten A werden in Tabelle1 und Tabelle2 die doppelten markiert.
Aber es ist keine Markierung in den Spalten B und C. Dort müßte aber auch ganz sicher was gefunden werden.
vielen Dank für Deine Hilfe. Leider funktioniert das Makro
noch nicht ganz. Was funktioniert ist: die doppelten aus
Tabelle2 werden markiert und in Auswertung geschoben. In den
Spalten A werden in Tabelle1 und Tabelle2 die doppelten
markiert.
Aber es ist keine Markierung in den Spalten B und C. Dort
müßte aber auch ganz sicher was gefunden werden.
Hallo Birgit,
die Prozedur geht Spalte A in Tab2 herunter und wenn ein Zellwert daraus in A oder B oder C von Tab1 gefunden wird so wird dieser farblich markiert und in Tab2 auch.
Bastle mal eine Beispielmappe und lade sie hoch mit FAQ:2606
