AW: doppelte Einträge auf zwei Tabellenblätter markier
11.11.2012 15:25:21
Matze,Matthias
Dieses Makro von : https://www.herber.de/mailing/029298h.htm
Tabellen vergleichen
Problem: Ich möchte 2 Tabellen in 2 Arbeitsmappen miteinander vergleichen und die Datensätze, die nicht doppelt vorkommen, in einer neuen Arbeitsmappe sammeln. Wie kann ich das Problem über VBA lösen?
könnte man umgestallten, lasse hier offen, dann kann ein Profi mal hier was bewirken.
Sub Vergleichen()
Dim wkb As Workbook
Dim wksA As Worksheet, wksB As Worksheet, wksC As Worksheet
Dim iWks As Integer, iRow As Integer, iRowT As Integer
On Error Resume Next
For iWks = 1 To 3
Set wkb = Workbooks("Mappe" & iWks)
Next iWks
If Err > 0 Or wkb Is Nothing Then
Beep
Err.Clear
MsgBox prompt:="Die 3 Arbeitsmappen sind nicht vorhanden!"
Exit Sub
End If
On Error GoTo 0
Set wksA = Workbooks("Mappe1").Worksheets(1) 'anpassen
Set wksB = Workbooks("Mappe2").Worksheets(1) 'anpassen
Set wksC = Workbooks("Mappe3").Worksheets(1) 'anpassen
iRow = 1
Do Until IsEmpty(wksA.Cells(iRow, 1))
If WorksheetFunction.CountIf( _
wksB.Columns(1), _
wksA.Cells(iRow, 1).Value) = 0 Then
iRowT = iRowT + 1
wksC.Cells(iRowT, 1).Value = wksA.Cells(iRow, 1).Value
wksC.Cells(iRowT, 2).Value = wksA.Parent.Name
End If
iRow = iRow + 1
Loop
iRow = 1
Do Until IsEmpty(wksB.Cells(iRow, 1))
If WorksheetFunction.CountIf( _
wksA.Columns(1), _
wksB.Cells(iRow, 1).Value) = 0 Then
iRowT = iRowT + 1
wksC.Cells(iRowT, 1).Value = wksB.Cells(iRow, 1).Value
wksC.Cells(iRowT, 2).Value = wksB.Parent.Name
End If
iRow = iRow + 1
Loop
End Sub
Gruß Matze
PS: Wenn du deinen Beitrag demnächst auf "offen" markiertst, werden das ALLE USER sehen und
dir somit schneller Antworten.