2.3k Aufrufe
Gefragt in Tabellenkalkulation von

Hallo zusammen,

ich möchte zwei Arbeitsmappen, wobei diese immer gleich aufgebaut sind, miteinander vergleichen.

Hierbei gibt es immer eine Master-Mappe und eine zweite Mappe. Die zweite Mappe wird von anderen Mitarbeitern betreut und ergänz/aktualisiert. In regelmässigen Abständen soll die Master-Mappe nun mit der zweiten Mappe verglichen und aktualisiert werden. Dabei sollen allfällige Differenzen zuerst in einer Message-Box angezeigt werden, worüber man entscheiden kann, ob die Differenz in die Master-Mappe übertragen oder verworfen werden sollen.

Wie bereits erwähnt, sind die zwei Mappen identisch aufgebaut. Die zwei Mappen sollten über ein Menü geöffnet werden können. Der Abgleich der Daten muss nicht über die gesamte Mappe sondern nur über zwei Blätter ("Stammdaten" + "Kunden") erfolgen.

Ich habe eine ähnliche Aufgabenstellung gefunden, bin jedoch überfordert mit VBA.

http://supportnet.de/forum/2486994/zwei-excel-dateien-synchronisieren-makro-vba

Leider funktionierte es auch mit "Arbeitsmappe zusammenführen und vergleichen" nicht, da die Files bereits Makros implementiert haben und diese mit der Funktion nicht mehr oder nur noch eingeschränkt funktionieren.

Kann mir jemand weiterhelfen? ich bin dankbar für jeden Tipp.

Gruss Andreas

17 Antworten

0 Punkte
Beantwortet von m-o Profi (22.7k Punkte)

Hallo Andreas,

wenn du mal zwei Beispielmappen hochladen könntest (Anleitung), die im Aufbau deinen Originaldateien gleichen und ein paar Dummy-Daten enthalten, dann könnte man dir wahrscheinlich helfen.

Gruß

M.O.

0 Punkte
Beantwortet von

Hallo M.O.

nachfolgend findest Du eine Beispielmappe: Beispieldatei

Kurze Beschreibung dazu: Über ein Java-Tool wird das Blatt "Daten" Bereich B4:E34 aktualisiert.

Zusätzlich müssen im Blatt "Zusatzdaten" einige Daten manuell eingetragen werden, da diese im System

nicht vorhanden sind.

Wie beschrieben, wird die Datei einmal ausgewertet und als Master gespeichert. Im Nachhinein können sich die Systemdaten jedoch nochmals ändern. Somit wird später die Datei nochmals ausgewertet und nun soll, wie in der ersten Frage erklärt, der Abgleich zwischen dem Master-File und der neuen Auswertung erfolgen.

ich hoffe, es ist einigermassen verständlich beschrieben. Ansonsten einfach Fragen.

Danke schon mal im Voraus für die Bemühungen.

Gruss Andreas

0 Punkte
Beantwortet von m-o Profi (22.7k Punkte)

Hallo Andreas,

du schreibst

Die zwei Mappen sollten über ein Menü geöffnet werden können.

Der Abgleich soll also über eine dritte Datei erfolgen?

Dabei sollen auffällige Differenzen zuerst in einer Message-Box angezeigt werden

Was verstehst du unter "auffällige Differenzen"?

Und wie sehen die möglichen Änderungen aus? Gibt es nur Änderungen in den bereits vorhandenen Eintragen (so dass man im Prinzip Zelle für Zelle der beiden Tabellen vergleichen kann) oder können sich auch neue Daten zwischen den vorhandenen Zeilen eingefügt werden?

Gruß

M.O.

0 Punkte
Beantwortet von
Hallo M.O.

Der Abgleich kann direkt über die zwei Mappen erfolgen. Die später erzeugte Mappe soll mit der Mastermappe verglichen werden. Wenn es Differenzen gibt, soll für jede Differenz eine Message-Box auftauchen, worin man wählen kann, ob die Differenz in die Master-Mappe übernommen oder verworfen werden soll. Demzufolge gehe ich davon aus, dass keine dritte Datei notwendig ist. Es kann sein, dass in der Master-Mappe noch keine Einträge vorgekommen sind und in der späteren Auswertung jedoch Daten vorkommen. In diesem Fall soll auch über die Message-Box die Abfrage erscheinen, ob der Wert übernommen werden soll.

Die Struktur der Files ist immer gleich. Das heisst, die Master-Mappe und die anderen Mappen sind von der Struktur immer gleich aufgebaut. Es dürfen keine weiteren Zeilen eingefügt oder die Struktur verändert werden.

Ich hoffe, Dir mit diesen Informationen dienen zu können.

Danke und Gruss

Andreas
0 Punkte
Beantwortet von m-o Profi (22.7k Punkte)
Bearbeitet von m-o

Hallo Andreas,

das folgende Makro gehört in ein Standardmodul deiner Master-Arbeitsmappe:

Sub vergleichen()

Dim Datei As Variant
Dim strDateiname As String
Dim i As Long
Dim lngLZeile1 As Long
Dim lngLSpalte1 As Long
Dim lngLZeile2 As Long
Dim lngLSpalte2 As Long
Dim arrDaten As Variant
Dim arrZusatzdaten As Variant
Dim arrMDaten As Variant
Dim arrMZusatzdaten As Variant
Dim z As Long
Dim s As Long
Dim Antwort

'Datei-Öffnen Dialog aufrufen
Datei = Application.GetOpenFilename(FileFilter:="Microsoft Excel-Dateien (*.xl*), *.xl*", Title:="EINE Datei zum Öffnen auswählen")
If Datei = False Then
        'Makro abbrechen wenn Benutzer den Öffnen-Dialog abbricht
        MsgBox "Der Benutzer hat abgebrochen.", vbInformation
        Exit Sub
End If
        
'Bildschirmaktualisierung ausschalten:
Application.ScreenUpdating = False
        
'ausgewählte Datei öffnen
Workbooks.Open (Datei)
        

With ActiveWorkbook
  For i = 1 To .Worksheets.Count
    'Arbeitsblatt Daten suchen
    If .Worksheets(i).Name = "Daten" Then
      'Daten aus Arbeitsblatt in Array einlesen
      With Worksheets(i)
        lngLZeile1 = .Cells(Rows.Count, 1).End(xlUp).Row                          'letzte Zeile ermitteln
        lngLSpalte1 = .Cells(2, Columns.Count).End(xlToLeft).Column               'letzte Spalte ermitteln
        'Prüfen, ob letzte Zeile und Spalte mit Masterdatei identisch sind, ansonsten ggf. anpassen
        If lngLZeile1 < ThisWorkbook.Worksheets("Daten").Cells(Rows.Count, 1).End(xlUp).Row Then lngZeile1 = ThisWorkbook.wokrsheets("Daten").Cells(Rows.Count, 1).End(xlUp).Row
        If lngLSpalte1 < ThisWorkbook.Worksheets("Daten").Cells(2, Columns.Count).End(xlToLeft).Column Then lngSpalte1 = ThisWorkbook.Worksheets("Daten").Cells(2, Columns.Count).End(xlToLeft).Column
        ReDim arrDaten(lngLZeile1, lngLSpalte1)                                     'Array redimensionieren
        arrDaten = .Range(.Cells(1, 1), .Cells(lngLZeile1, lngLSpalte1))            'Daten ins Array einlesen
      End With
    End If
    'Arbeitsblatt Zusatzdaten suchen
    If .Worksheets(i).Name = "Zusatzdaten" Then
      With Worksheets(i)
        lngLZeile2 = .Cells(Rows.Count, 1).End(xlUp).Row
        lngLSpalte2 = .Cells(2, Columns.Count).End(xlToLeft).Column
        If lngLZeile2 < ThisWorkbook.Worksheets("Daten").Cells(Rows.Count, 1).End(xlUp).Row Then lngZeile2 = ThisWorkbook.wokrsheets("Daten").Cells(Rows.Count, 1).End(xlUp).Row
        If lngSpalte2 < ThisWorkbook.Worksheets("Daten").Cells(2, Columns.Count).End(xlToLeft).Column Then lngSpalte2 = ThisWorkbook.Worksheets("Daten").Cells(2, Columns.Count).Column
        ReDim arrZusatzdaten(lngLZeile2, lngLSpalte2)
        arrZusatzdaten = .Range(.Cells(1, 1), .Cells(lngLZeile2, lngLSpalte2))
      End With
    End If
    
  Next i
 
  'Prüfen, ob Tabellenblätter gefunden wurden und ggf. Fehlermeldung ausgeben und Makro abbrechen
  If IsEmpty(arrDaten) And IsEmpty(arrZusatzdaten) Then
    MsgBox "Achtung! Die Arbeitsblätter ""Daten"" und ""Zusatzdaten"" wurden in der Datei " & .Name & " nicht gefunden!", 16, "Abbruch wegen Fehler"
    Exit Sub
  End If
 
  If IsEmpty(arrDaten) Then
    MsgBox "Achtung! Das Arbeitsblatt ""Daten"" wurde in der Datei " & .Name & " nicht gefunden!", 16, "Abbruch wegen Fehler"
    Exit Sub
  End If

  If IsEmpty(arrZusatzdaten) Then
    MsgBox "Achtung! Das Arbeitsblatt ""Zusatzdaten"" wurde in der Datei " & .Name & " nicht gefunden!", 16, "Abbruch wegen Fehler"
    Exit Sub
  End If
   
  'Name der geöffnenten Datei in Variable schreiben
  strDateiname = .Name
     
  'geöffnete Datei wieder schließen, ohne zu speichern
  .Close (False)

End With

'Bildschirmaktualisierung einschalten:
Application.ScreenUpdating = True

'Inhalte der Arbeitsblätter Daten vergleichen
'Zuerst Daten in Array einlesen
With ThisWorkbook.Worksheets("Daten")
    .Activate                                                      'auf Arbeitsblatt wechseln
    ReDim arrMDaten(lngLZeile1, lngLSpalte1)
    arrMDaten = .Range(.Cells(1, 1), .Cells(lngLZeile1, lngLSpalte1))
    'nun Daten vergleichen
    For z = 1 To UBound(arrMDaten, 1)
      For s = 1 To UBound(arrMDaten, 2)
         'Falls unterschiedliche Daten vorhanden, nachfragen, ob Daten aktualisiert werden sollen
         If arrMDaten(z, s) <> arrDaten(z, s) Then
           'betreffende Zelle auswählen
           .Cells(z, s).Select
           Antwort = MsgBox("Zelle " & Cells(z, s).Address & vbLf & "Daten in Master: " & arrMDaten(z, s) & vbLf & "Daten in " & strDateiname & ": " & arrDaten(z, s), 36, "Daten in Masterdatei aktualiseren?")
           'Falls OK gedrückt wird, Daten in Masterdatei überschreiben
           If Antwort = vbYes Then .Cells(z, s) = arrDaten(z, s)
         End If
      Next s
    Next z
End With

'Inhalte der Arbeitsblätter Daten vergleichen
'Zuerst Zusatzdaten in Array einlesen
With ThisWorkbook.Worksheets("Zusatzdaten")
    .Activate                                                      'auf Arbeitsblatt wechseln
    ReDim arrMZusatzdaten(lngLZeile2, lngLSpalte2)
    arrMZusatzdaten = .Range(.Cells(1, 1), .Cells(lngLZeile2, lngLSpalte2))
    'nun Daten vergleichen
    For z = 1 To UBound(arrMZusatzdaten, 1)
      For s = 1 To UBound(arrMZusatzdaten, 2)
         'Falls unterschiedliche Daten vorhanden, nachfragen, ob Daten aktualisiert werden sollen
         If arrMZusatzdaten(z, s) <> arrZusatzdaten(z, s) Then
           .Cells(z, s).Select
           Antwort = MsgBox("Zelle " & Cells(z, s).Address & vbLf & "Daten in Master: " & arrMZusatzdaten(z, s) & vbLf & "Daten in " & strDateiname & ": " & arrZusatzdaten(z, s), 36, "Daten in Masterdatei aktualiseren?")
           If Antwort = vbYes Then .Cells(z, s) = arrZusatzdaten(z, s)
         End If
      Next s
    Next z
End With

'Abschlussmeldung
MsgBox "Vergleich abgeschlossen!", 48, "Info"

End Sub

Teste es erst einmal in einer Testversion deiner Mastermappe und schau mal, ob alles richtig funktioniert.

In der Master-Arbeitsmappe wird nicht geprüft, ob die Tabellenblätter "Daten" und "Zusatzdaten" vorhanden sind.

Gruß

M.O.

0 Punkte
Beantwortet von
Hallo M.O.

vielen Dank für deine rasche Antwort.

ich werde es morgen testen und dir wieder Bescheid geben, ob ich erfolgreich war.

Gruss

Andreas
0 Punkte
Beantwortet von

Hallo M.O.

ich habe das erste Probleme:

1. beim Debuggen bring er die Meldung, dass es ein "End With" ohne "With" hat, jedoch kann ich mir das nicht erklären. Der Einstieg erfolgt ja über "With Worksheets (i)".

With ActiveWorkbook
  For i = 1 To .Worksheets.Count
    'Arbeitsblatt Daten suchen
    If .Worksheets(i).name = "Daten" Then
      'Daten aus Arbeitsblatt in Array einlesen
      With Worksheets(i)
        lngLZeile1 = .Cells(Rows.Count, 1).End(xlUp).Row                          'letzte Zeile ermitteln
        lngLSpalte1 = .Cells(2, Columns.Count).End(xlToLeft).Column               'letzte Spalte ermitteln
        'Prüfen, ob letzte Zeile und Spalte mit Masterdatei identisch sind, ansonsten ggf. anpassen
        If lngLZeile1 < ThisWorkbook.Worksheets("Daten").Cells(Rows.Count, 1).End(xlUp).Row Then
        lngZeile1 = ThisWorkbook.Worksheets("Daten").Cells(Rows.Count, 1).End(xlUp).Row
        If lngLSpalte1 < ThisWorkbook.Worksheets("Daten").Cells(2, Columns.Count).End(xlToLeft).Column Then
        lngSpalte1 = ThisWorkbook.Worksheets("Daten").Cells(2, Columns.Count).End(xlToLeft).Column
        ReDim arrDaten(lngLZeile1, lngLSpalte1)                                     'Array redimensionieren
        arrDaten = .Range(.Cells(1, 1), .Cells(lngLZeile1, lngLSpalte1))            'Daten ins Array einlesen
      End With

0 Punkte
Beantwortet von beverly_ Experte (3.3k Punkte)

Hi,

das Problem ist nicht das fehlende End With sondern die Zeile If lngLZeile1 < .... und die darauffolgende Zeile lngZeile1 = ... gehören in eine gemeinsame Zeile. Dasselbe betrifft auch die beiden darauffolgenden Zeilen If lngLSpalte1 <.... und lngSpalte1 = ... zu.

Excel hat manchmal Probleme, die korrekte Ursache zu bennen.

Wenn dir die Zeilen zu lang sind kannst du sie auch umbrechen:

If lngLZeile1 < ThisWorkbook.Worksheets("Daten").Cells(Rows.Count, 1).End(xlUp).Row Then _
    lngZeile1 = ThisWorkbook.Worksheets("Daten").Cells(Rows.Count, 1).End(xlUp).Row
If lngLSpalte1 < ThisWorkbook.Worksheets("Daten").Cells(2, Columns.Count).End(xlToLeft).Column Then _
    lngSpalte1 = ThisWorkbook.Worksheets("Daten").Cells(2, Columns.Count).End(xlToLeft).Column

Bis später, Karin

0 Punkte
Beantwortet von m-o Profi (22.7k Punkte)

Hallo Andreas,

prüfe bitte, ob der Code wie oben in meiner Antwort in dem Modul steht.

Insbesondere die Zeilen

 If lngLZeile1 < ThisWorkbook.Worksheets("Daten").Cells(Rows.Count, 1).End(xlUp).Row Then
        lngZeile1 = ThisWorkbook.Worksheets("Daten").Cells(Rows.Count, 1).End(xlUp).Row 

und

If lngLSpalte1 < ThisWorkbook.Worksheets("Daten").Cells(2, Columns.Count).End(xlToLeft).Column Then
        lngSpalte1 = ThisWorkbook.Worksheets("Daten").Cells(2, Columns.Count).End(xlToLeft).Column 

müssen jeweils in einer Zeile stehen (ohne Zeilenumbruch), sonst wird hier ein End If erwartet, was zu deinem Fehler führen kann.

Gruß

M.O.

0 Punkte
Beantwortet von

Hallo Karin und M.O.

zuerst vielen Dank für den Hinweis betr. Code in gleicher Zeile. Das funktioniert nun.

Nun bringt er beim Debuggen bei der nachfolgend gelb markierten Pos. folgende Fehlermeldung:

Laufzeitfehler '9': Index ausserhalb des gültigen Bereichs.

With ActiveWorkbook

  For i = 1 To .Worksheets.Count
    'Arbeitsblatt Daten suchen
    If .Worksheets(i).name = "Daten" Then
      'Daten aus Arbeitsblatt in Array einlesen
      With Worksheets(i)
        lngLZeile1 = .Cells(Rows.Count, 1).End(xlUp).Row                          'letzte Zeile ermitteln
        lngLSpalte1 = .Cells(2, Columns.Count).End(xlToLeft).Column               'letzte Spalte ermitteln
        'Prüfen, ob letzte Zeile und Spalte mit Masterdatei identisch sind, ansonsten ggf. anpassen
        If lngLZeile1 > ThisWorkbook.Worksheets("Daten").Cells(Rows.Count, 1).End(xlUp).Row Then lngZeile1 = ThisWorkbook.Worksheets("Daten").Cells(Rows.Count, 1).End(xlUp).Row
        If lngLSpalte1 < ThisWorkbook.Worksheets("Daten").Cells(2, Columns.Count).End(xlToLeft).Column Then lngSpalte1 = ThisWorkbook.Worksheets("Daten").Cells(2, Columns.Count).End(xlToLeft).Column
        ReDim arrDaten(lngLZeile1, lngLSpalte1)                                     'Array redimensionieren
        arrDaten = .Range(.Cells(1, 1), .Cells(lngLZeile1, lngLSpalte1))            'Daten ins Array einlesen
      End With

den Code selbst habe ich in einem Modul, jedoch wird der Prozess über ein allg. Menü aufgerufen:

gibt es deshalb diesen Fehler?

vielen Dank für eure Hilfe.

Gruss Andreas

...