Microsoft Excel

Excel und VBA: Formeln, Programmierung, Lösungen

Die Excel/VBA-Beispiele

Thema

Tabellen vergleichen

Gruppe

Vergleich

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?

Lösung
Geben Sie den nachfolgenden Code in ein Standardmodul ein und weisen Sie ihn einer Schaltfläche zu.

StandardModule: basMain

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)
   Set wksB = Workbooks("Mappe2").Worksheets(1)
   Set wksC = Workbooks("Mappe3").Worksheets(1)
   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