Anzeige
Archiv - Navigation
1696to1700
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Tabellenvergleich

Tabellenvergleich
25.06.2019 09:54:28
KathrinZ
Hallo zusammen,
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. -
  • Sollten diese identisch sein (keine unterschiedlichen/überschriebenen Werte, wird die Zeile in Tabellenblatt Kopie gelöscht.

  • Sind einzelne/mehrere Werte verschieden, so wird die Zeile in Kopie kopiert und in das Tabellenblatt 1 in der Zeile der richtigen Kostenstelle eingefügt (--> überschrieben!) Die Zeile in "Kopie" wird gelöscht

  • Sollte es die Kostenstelle in Tabellenblatt 1 überhaupt noch nicht geben, was vorkommen kann, so wird diese einfach in der Tabelle in Tabellenblatt 1 unten angefügt. Die Zeile in "Kopie" wird gelöscht.

  • 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!!!

    3
    Beiträge zum Forumthread
    Beiträge zu diesem Forumthread

    Betreff
    Datum
    Anwender
    Anzeige
    AW: Tabellenvergleich
    25.06.2019 11:21:07
    Daniel
    Hallo Kathrin,
    ich habe das Gefühl, da hast du etwas zu kompliziert gedacht. Zum Beispiel unterscheiden sich deine Schritte 1 und 2 im Ergebnis nicht. Egal, ob sich die Werte geändert haben oder nicht, in beiden Fällen können die neuen Werte aus "Kopie" übertragen werden, wenn die Kostenstelle in Tabelle1 gefunden wird (ist einfacher als gleiche Werte nicht zu kopieren).
    Ich würde dir generell auch sehr empfehlen, immer mit Option Explicit zu arbeiten. Einfach, damit du Fehler bei deinen Variablen (gerade Tippfehler!) schneller findest.
    Hier mal mein Ansatz:
    Sub Vergleich()
    Dim Zelle As Range
    Dim wsOr As Worksheet, wsKo As Worksheet
    Dim Suchrange As Range, Kopierrange As Range
    Set wsOr = ThisWorkbook.Worksheets("Tabelle1")
    Set wsKo = ThisWorkbook.Worksheets("Kopie")
    Set Kopierrange = wsKo.UsedRange.Columns(1).Offset(1, 0)
    For Each Zelle In Kopierrange.Resize(Kopierrange.Rows.Count - 1).Cells
    Set Suchrange = wsOr.Columns(1).Find(what:=Zelle.Value, LookIn:=xlValues, LookAt:=xlWhole)
    If Suchrange Is Nothing Then
    Zelle.EntireRow.Copy wsOr.Cells(wsOr.Rows.Count, 1).End(xlUp).Offset(1, 0)
    Zelle.EntireRow.Clear
    Else
    Zelle.EntireRow.Copy Suchrange
    Zelle.EntireRow.Clear
    End If
    Next Zelle
    Set wsOr = Nothing
    Set wsKo = Nothing
    Set Kopierrange = Nothing
    End Sub
    
    Ich gehe alle benutzten Felder in Spalte A auf dem Kopierblatt durch (KST) und kopiere entweder den Inhalt der Zeile nach Tabelle1, wenn die KST gefunden wurde, oder kopiere sie unter die letzte Zeile in Tabelle1 falls sie neu ist.
    Gruß
    Daniel
    Anzeige
    AW: Tabellenvergleich
    25.06.2019 11:45:11
    KathrinZ
    Ich danke Dir vielmals Daniel!
    Auf meine komplizierte Denkweise haben mich schon die Profs und Übungsleiter in der Uni hingewiesen als ich es mit Java probiert hab. Und wenn ich dann seh wie einfach es eigentlich geht...
    Auf jeden Fall lieben Dank nochmal :-)
    Lg Kathrin
    Gern geschehen! owT
    25.06.2019 11:58:22
    Daniel

    Beliebteste Forumthreads (12 Monate)

    Anzeige

    Beliebteste Forumthreads (12 Monate)

    Anzeige
    Anzeige
    Anzeige