VBA: Spalten aus 2 Dateien vergleichen

Informationen und Beispiele zu den hier genannten Dialog-Elementen:
MsgBox
Bild

Betrifft: VBA: Spalten aus 2 Dateien vergleichen
von: Emre
Geschrieben am: 06.08.2015 17:03:29

Hallo zusammen,
brauche eure Hilfe, es geht darum, dass ich 2 Dateien habe. In diesen Dateien befinden sich Tabellen, deren Größe sich ständig ändern kann. Das heißt es können neue Werte hinzukommen.
Ich muss die Spalte B aus Datei 1 und Spalte C aus Datei 2 vergleichen. Also, ich muss dann in einem der Dateien, in einem neuen Tabellenblatt auflisten, welche Werte in beiden Dateien vorkommen. Welche nur in Datei 1 vorkommen und welche nur in Datei 2 vorkommen.
Hoffe habe mein Problem erklären können. Wäre für eine Hilfe sehr dankbar.
Gruß
Emre

Bild

Betrifft: AW: VBA: Spalten aus 2 Dateien vergleichen
von: Sepp
Geschrieben am: 06.08.2015 23:34:03
Hallo Emre,
in ein allgemeines Modul der Datei A. Datei B wird per Dialog ausgewählt, die Ausgabe erfolgt auf einem neuen Blatt in Datei A.

' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Sub compare()
Dim objWB As Workbook, objNewSheet As Worksheet
Dim strFile As String, strTabA As String, strTabB As String
Dim vntA As Variant, vntB As Variant, vntOut As Variant
Dim lngFirstData As Long, lngI As Long, lngBoth As Long, lngA As Long, lngB As Long
Dim vntRet As Variant

On Error GoTo ErrExit

With Application
  .ScreenUpdating = False
  .EnableEvents = False
  .Calculation = xlManual
  .DisplayAlerts = False
End With

lngFirstData = 2 'Erste Datenzeile

With Application.FileDialog(msoFileDialogFilePicker)
  .InitialFileName = "E:\Forum"
  .Title = "Datei auswählen"
  .ButtonName = "Auswahl..."
  .InitialView = msoFileDialogViewList
  If .Show = -1 Then strFile = .SelectedItems(1)
End With

If Len(strFile) Then
  strTabA = "Tabelle1" 'Name der Tabelle in dieser Datei (Datei A)
  strTabB = "Tabelle1" 'Name der Tabelle in Datei B
  
  Set objWB = Workbooks.Open(strFile)
  With objWB.Sheets(strTabB)
    vntB = .Range(.Cells(lngFirstData, 3), .Cells(Application.Max(lngFirstData, .Cells(.Rows.Count, _
      3).End(xlUp).Row), 3))
  End With
  objWB.Close False
  With ThisWorkbook.Sheets(strTabA)
    vntA = .Range(.Cells(lngFirstData, 2), .Cells(Application.Max(lngFirstData, .Cells(.Rows.Count, _
      2).End(xlUp).Row), 2))
  End With
  
  Redim vntOut(1 To UBound(vntA, 1) + UBound(vntB, 1), 1 To 3)
  
  
  For lngI = 1 To UBound(vntA, 1)
    vntRet = Application.Match(vntA(lngI, 1), vntB, 0)
    If IsNumeric(vntRet) Then
      lngBoth = lngBoth + 1
      vntOut(lngBoth, 1) = vntA(lngI, 1)
      vntA(lngI, 1) = ""
      vntB(vntRet, 1) = ""
    Else
      lngA = lngA + 1
      vntOut(lngA, 2) = vntA(lngI, 1)
      vntA(lngI, 1) = ""
    End If
  Next
  For lngI = 1 To UBound(vntB, 1)
    If vntB(lngI, 1) <> "" Then
      vntRet = Application.Match(vntB(lngI, 1), vntA, 0)
      If IsNumeric(vntRet) Then
        lngBoth = lngBoth + 1
        vntOut(lngBoth, 1) = vntB(lngI, 1)
        vntB(lngI, 1) = ""
        vntA(vntRet, 1) = ""
      Else
        lngB = lngB + 1
        vntOut(lngB, 3) = vntB(lngI, 1)
        vntB(lngI, 1) = ""
      End If
    End If
  Next
  
  Set objNewSheet = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
  With objNewSheet
    .Name = "Compare_" & Format(Now, "yyyyMMdd-hhmmss")
    .Range("A1") = "In A & B"
    .Range("B1") = "Nur in A"
    .Range("C1") = "Nur in B"
    .Range("A2").Resize(UBound(vntOut, 1), 3) = vntOut
  End With
End If

ErrExit:

With Err
  If .Number <> 0 Then
    MsgBox "Fehler in Prozedur:" & vbTab & "'compare'" & vbLf & String(60, "_") & _
      vbLf & vbLf & IIf(Erl, "Fehler in Zeile:" & vbTab & Erl & vbLf & vbLf, "") & _
      "Fehlernummer:" & vbTab & .Number & vbLf & vbLf & "Beschreibung:" & vbTab & _
      .Description & vbLf, vbExclamation + vbMsgBoxSetForeground, _
      "VBA - Fehler in Prozedur - compare"
    .Clear
  End If
End With

On Error GoTo 0

With Application
  .ScreenUpdating = True
  .EnableEvents = True
  .Calculation = xlAutomatic
  .DisplayAlerts = True
  .StatusBar = False
End With

Set objWB = Nothing
Set objNewSheet = Nothing
End Sub


Gruß Sepp


Bild

Betrifft: AW: VBA: Spalten aus 2 Dateien vergleichen
von: Emre
Geschrieben am: 07.08.2015 18:03:05
Hallo Sepp,
hat super funktioniert. Musste es ein wenig anpassen aber hat geklappt vielen Dank für deine Hilfe.
Gruß
Emre

 Bild

Beiträge aus den Excel-Beispielen zum Thema "VBA: Spalten aus 2 Dateien vergleichen"