Tabellenvergleich
25.06.2019 09:54:28
KathrinZ
ich soll für die Planung der Kostenstellen ein Makro schreiben, weil wir wegen eines Tools etwas eingeschränkt sind in der Excelbearbeitung. Und zwar generiert mir mein Tool eine Tabelle und diese will ich auf ein zweites Tabellenblatt kopieren. Auf der zweiten Seite kann ich dann mittels Copy Paste dann die Tabelle eventuell mit neuen Werten überschreiben. Das Makro soll mir jetzt folgendes ermöglichen:
Erst soll die Tabelle kopiert werden auf Tabellenblatt 2.
Mit einem Druck auf den Command Button beginnt der Tabellenvergleich:
Dabei wird Zeile pro Zeile vorgegangen: Die Kostenstelle in der ersten Zeile von der Kopie wird in eine Variable gespeichert und in der ursprünglichen Tabelle auf Tabellenblatt 1 gesucht. Daraufhin wird die komplette Zeile der Kopie mit der zugehörigen Zeile der Kostenstelle in der ursprünglichen Tabelle verglichen. -
Somit sollten am Schluss keine Zeilen mehr im Tabellenblatt Kopie vorhanden sein und die Zeilen einzeln in das ursprüngliche Tabellenblatt übertragen worden sein. Leider geht das nur Zeile für Zeile, da aufgrund des Tools kein kompletter Datensatz mittels Copy Paste in das ursprüngliche Tabellenblatt übertragen werden können. Das wäre natürlich viel einfacher und würde kein Makro benötigen...
Ich hab es schon mal probiert, aber ich kriege immer wieder den selben Fehler. Es sind viele Kommentare drin, die ich noch nicht rausschmeißen wollte, die aber unnütz sind. Kann mir bitte jemand helfen? Ich sitz da jetzt schon ziemlich lange dran und krieg immer wieder den selben Fehler mit fehlenden Objektvariablen oder With Fehlern.
------------------------------------------------------------------------
Sub TabelleKopieren()
Worksheets("Tabelle1").Copy After:=Worksheets("Tabelle1")
Worksheets("Tabelle1 (2)").Name = "Kopie"
End Sub
Private Sub Verteilen_Click()
'Sub Vgl()
'Dim Kopie As Object
'Set Kopie = Sheets("Kopie")
Dim kostenstelle As String
Dim rng As range
Dim letztezeile As Long
Dim letztespalte As Long
Dim i As Integer
'With Kopie
'Finde letztezeile
letztezeile = Worksheets("Kopie").UsedRange.SpecialCells(xlCellTypeLastCell).Row
MsgBox (letztezeile)
'Finde letztespalte
letztespalte = Worksheets("Kopie").Cells(1, 256).End(xlToLeft).Column
MsgBox (letztespalte)
'erste Kostenstelle in Zeile 2 nehmen
kostenstelle = Worksheets("Kopie").Cells(2, 1).Value
MsgBox (kostenstelle)
'selbe Kostenstelle in Originaltabelle suchen und Zeile rausspeichern
Set rng = Worksheets("Tabelle1").Columns(1).Find(what:=kostenstelle, LookIn:=xlValues)
MsgBox (rng.Row)
'Fall 1: KSt in Kopie existiert nicht in Tabelle1
'Zeile mit KSt in Kopie wird kopiert und in Tabelle1 unten angefügt
'Zeile mit KSt in Kopie wird gelöscht
If rng Is Nothing Then
MsgBox "Nichts gefunden für Kostenstelle" & kostenstelle
'Worksheets("Kopie").range(Cells(i, 1), Cells(1, letztespalte)).Copy _
'Worksheets("Tabelle1").range(Cells(letztezeile+1, 1), Cells(letztezeile+1, _
letztespalte)).End(xlUp).Offset(1)
'Worksheets("Kopie").Row(i).EntireRow.Delete
Worksheets("Kopie").range(Cells(2, 1), Cells(1, 9)).Copy _
Worksheets("Tabelle1").range(Cells(7 + 1, 1), Cells(7 + 1, 9)).End(xlUp).Offset(1)
Worksheets("Kopie").Row(2).EntireRow.Delete
Else
'Zeile in Kopie mit zugehöriger Zeile im Original vergleichen
'Fall 2: Zeile mit KSt in Kopie entspricht exakt Zeile mit Kst in Tabelle1
'Wenn die Zeilen einander entsprechen, Zeile in Kopie rauslöschen
'Zeilenzähler i = 2
For i = 2 To letztezeile
Dim bereichKopie As range
Dim bereichTabelle1 As range
Dim zellen, zelle
Set bereichKopie = Worksheets("Kopie").range(Cells(i, 1), Cells(i, letztespalte))
Set bereichTabelle1 = Worksheets("Tabelle1").range(Cells(rng.Row, 1), Cells(rng.Row, _
letztespalte))
For Each zellen In bereichKopie
For Each zelle In bereichTabelle1
If zellen.Value = zelle.Value Then
Worksheets("Kopie").Row(i).EntireRow.Delete
Exit For
'If Worksheets("Kopie").range(Cells(2, 1), Cells(1, 9)).Value = Worksheets("Tabelle1"). _
range(Cells(rng.row, 1), Cells(rng.row, 9)).Value Then
'Worksheets("Kopie").Row(2).EntireRow.Delete
'Fall 3: Zeile mit KSt in Kopie entspricht nicht Zeile mit Kst in Tabelle1
'Wenn sie nicht übereinstimmen, Zeile von Kopie in Original kopieren und in Kopie rauslö _
schen
Else
zellen.Copy _
zelle.Offset(1)
Worksheets("Kopie").Row(i).EntireRow.Delete
'Else
'Worksheets("Kopie").range(Cells(2, 1), Cells(1, 9)).Copy
'Worksheets("Tabelle1").range(Cells(rng.row, 1), Cells(rng.row, 9)).End(xlUp). _
Offset (1)
'Worksheets("Kopie").Row(2).EntireRow.Delete
End If
Next
Next
Next i
End If
'End With
End Sub
-------------------------------------------------------------------------
Folgendes Beispieldokument mit ein paar Kommentaren hab ich erstellt: https://www.herber.de/bbs/user/130569.xlsm
Unendlich viel Dank an die- oder denjenigen, der mir hier raushilft!!!