manuel1987 Geschrieben 10. Dezember 2009 Geschrieben 10. Dezember 2009 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
MartinSt Geschrieben 10. Dezember 2009 Geschrieben 10. Dezember 2009 Wobei weiterhelfen? Schon mit Wort "weiter-helfen" steckt ja drin, dass erstmal etwas von dir getan wird und dir dann jemand hilft.
manuel1987 Geschrieben 14. Dezember 2009 Autor Geschrieben 14. Dezember 2009 (bearbeitet) 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 2009 von manuel1987
manuel1987 Geschrieben 14. Januar 2010 Autor Geschrieben 14. Januar 2010 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ß
Empfohlene Beiträge
Erstelle ein Benutzerkonto oder melde Dich an, um zu kommentieren
Du musst ein Benutzerkonto haben, um einen Kommentar verfassen zu können
Benutzerkonto erstellen
Neues Benutzerkonto für unsere Community erstellen. Es ist einfach!
Neues Benutzerkonto erstellenAnmelden
Du hast bereits ein Benutzerkonto? Melde Dich hier an.
Jetzt anmelden