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

Wobei weiterhelfen?

Schon mit Wort "weiter-helfen" steckt ja drin, dass erstmal etwas von dir getan wird und dir dann jemand hilft.

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 14. Dezember 200915 j von manuel1987

Hier wird man ja überflutet von Tipps und Hilfe

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ß