Jump to content

2 Excel Tabellen vergleichen und zusammenführen

Empfohlene Beiträge

Hallo,

ich habe folgendes Problem.

Ich habe zwei Excel Tabellen, die sich vom Alter und Inhalt unterscheiden.

Tabelle 1 = Stammtabelle mit Daten die verglichen werden sollen und weiteren Daten.

Tabelle 2 = neue Tabelle aus einem Abzug

Beide Tabellen haben eine ID pro Zeile in der Spalte A. In Spalte B-H sind nun Daten enthalten, die abgeglichen werden müssen.

Ziel ist es, die Tabellen miteinander zu vergleichen und wenn

- in Tabelle 1 Datensätze sind, die in Tabelle 2 nicht vorhanden sind zu markieren (farblich oder durch einen Hinweis)

- in Tabelle 2 Datensätze vorhanden sind, die in Tabelle 1 nicht vorhanden sind, diese in Tabelle 1 einzufügen

- in Tabelle 2 Datensätze sich zu den Datensätzen in Tabelle 1 unterscheiden, diese in Tabelle 1 zu überschreiben.

Ich denke, Ziel 1 und 2 ist kein Problem, jedoch kenne ich mich in Excel bisher nicht gut aus... Es muss weiterhin Excel verwendet werden, da die Kollegen diese für ihre Verwaltung der Daten als Standard benutzen.

Und es sollte durch Formeln oder VBA realisiert werden und nichts kosten!

Ich hoffe, es kann mir jemand weiterhelfen.

Danke und Gruß

Manuel

Diesen Beitrag teilen


Link zum Beitrag
Auf anderen Seiten teilen

Also ich habe bisher folgenden Code, der auch die Punkte soweit erfüllt.

Option Explicit 


Sub DatenAbgleich() 

Dim arrT2 As Variant, arrT1 As Variant, arrRest As Variant 

Dim i As Long, j As Long, k As Long 

    With Sheets("Tabelle1") 

        arrT1 = .Range("A1", .Range("H" & Rows.Count).End(xlUp)) 

    End With 

    With Sheets("Tabelle2") 

        arrT2 = .Range("A1", .Range("H" & Rows.Count).End(xlUp)) 

    End With 

    For i = 1 To UBound(arrT2) 

        For j = 1 To UBound(arrT1) 

            If arrT1(j, 1) = arrT2(i, 1) Then 

                arrT1(j, 1) = "" 

                Exit For 

            End If 

        Next 

    Next 

    k = 1 

    ReDim arrRest(1 To 8, 1 To k) 

    arrRest(1, 1) = "folgende Datensätze sind nicht in Tabelle2 enthalten" 

    For j = 1 To UBound(arrT1) 

        If arrT1(j, 1) <> "" Then 

            k = k + 1 

            ReDim Preserve arrRest(1 To 8, 1 To k) 

            For i = 1 To 8 

                arrRest(i, k) = arrT1(j, i) 

            Next 

        End If 

    Next 

    With Sheets("Tabelle1") 

        .UsedRange.ClearContents 

        .Cells(1, 1).Resize(UBound(arrT2), 8) = arrT2 

        .Cells(UBound(arrT2) + 1, 1).Resize(UBound(arrRest, 2), 8) = WorksheetFunction.Transpose(arrRest) 

    End With 

End Sub

Nun noch mein Problem, wie ich die Datensätze markiere, die in Tabelle1 zu Tabelle2 unterschiedlich sind und überschrieben wurde, damit man auch weiss was geändert wurde. Da wäre eine Hilfe sehr nett, falls mich da jemand unterstützen könnte.

Außerdem würde ich gerne noch das Datum einfügen, wann das Makro ausgeführt wurde. Hier wäre eine Unterstützung sehr toll!

Danke und Gruß

Manuel

bearbeitet von manuel1987

Diesen Beitrag teilen


Link zum Beitrag
Auf anderen Seiten teilen

Hier wird man ja überflutet von Tipps und Hilfe :rolleyes:

Naja, die oben genannten Probleme wurden nun gelöst. Eventuell findet sich ja hier jemand, der mir noch beim letzten Problem in diesem Fall helfen kann...

Das Makro vergleicht nun beide Tabellen und führt sie zusammen. Jedoch habe ich noch das Problem, das in Tabelle 1 nach der Spalte H noch weitere relevante Datensätze vorhanden sind. Diese werden aber derzeit vom Makro überschrieben, da in Tabelle 2 diese Daten nicht vorhanden sind. Nun benötige ich eine Lösung, damit diese Spalten nicht überschrieben werden sondern bestehen bleiben und beim Vergleich "mitgeführt" werden.

Ich hoffe, ich habe mich verständlich ausgedrückt:D

Option Explicit


Sub DatenAbgleich()

Dim arrT2 As Variant, arrT1 As Variant, arrRest As Variant

Dim i As Long, j As Long, k As Long

    With Sheets("Tabelle1")

        arrT1 = .Range("A1", .Range("H" & Rows.Count).End(xlUp))

    End With

    With Sheets("Tabelle2")

        arrT2 = .Range("A1", .Range("H" & Rows.Count).End(xlUp))

    End With

    For i = 1 To UBound(arrT2)

        For j = 1 To UBound(arrT1)

            If arrT1(j, 1) = arrT2(i, 1) Then

                arrT1(j, 1) = ""

                Exit For

            End If

        Next

    Next

    k = 1

    ReDim arrRest(1 To 8, 1 To k)

    arrRest(1, 1) = "folgende Datensätze sind nicht in Tabelle2 enthalten"

    For j = 1 To UBound(arrT1)

        If arrT1(j, 1) <> "" Then

            k = k + 1

            ReDim Preserve arrRest(1 To 8, 1 To k)

            For i = 1 To 8

                arrRest(i, k) = arrT1(j, i)

            Next

        End If

    Next

    With Sheets("Tabelle1")

        .UsedRange.ClearContents

        .Cells(1, 1).Resize(UBound(arrT2), 8) = arrT2

        .Cells(UBound(arrT2) + 1, 1).Resize(UBound(arrRest, 2), 8) = WorksheetFunction.Transpose(arrRest)

        .Cells(UBound(arrT2) + 1 + UBound(arrRest, 2) + 1, "A") = "Ausgeführt am " & Format(Date, "DD.MM.YYYY") & " um " & Format(Now, "hh:mm") & " Uhr"

    End With

    Dim newname

    newname = "EA" & Format(Date, "YYYYMMDD")

    ThisWorkbook.SaveAs (ThisWorkbook.Path & "\" & newname)

End Sub

Danke im Voraus für die Hilfe.

Gruß

Diesen Beitrag teilen


Link zum Beitrag
Auf anderen Seiten teilen

Nimm an der Diskussion teil

Du kannst jetzt hier posten und Dich später registrieren. Wenn Du bereits über eine Konto verfügst, melde Dich jetzt an, um mit Deinem Konto zu posten.

Gast
Auf dieses Thema antworten...

×   Du hast formatierten Text eingefügt.   Formatierung jetzt entfernen

  Only 75 emoji are allowed.

×   Dein Link wurde automatisch eingebettet.   Einbetten rückgängig machen und als Link darstellen

×   Dein vorheriger Inhalt wurde wiederhergestellt.   Clear editor

×   Du kannst Bilder nicht direkt einfügen. Lade Bilder hoch oder lade sie von einer URL.


Fachinformatiker.de, 2019 SE Internet Services

fidelogo_small.png

if_icon-6-mail-envelope-closed_314900.pnSchicken Sie uns eine Nachricht!

Fachinformatiker.de ist die größte IT-Community
rund um Ausbildung, Job, Weiterbildung für IT-Fachkräfte.

Fachinformatiker.de App


Get it on Google Play

Kontakt

Hier werben?
Oder senden Sie eine E-Mail an

Social media u. feeds

Jobboard für Fachinformatiker und IT-Fachkräfte

×
×
  • Neu erstellen...

Wichtige Information

Fachinformatiker.de verwendet Cookies. Mehr dazu in unserer Datenschutzerklärung