Anzeige
Archiv - Navigation
1700to1704
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
02.07.2019 14:57:39
KathrinZ
Hallo zusammen,
ich hab mich hier mit demselben Thema schon mal an Euch gewandt und brauch nochmal kurz Eure Hilfe.
Alter Teil:
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...
Hab dann folgendes Makro von einem Daniel gekriegt (super Kerl!):

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

Das hat mir auch schon alles gelöst. Nur verschieben sich innerhalb meines Tabellenblattes jetzt die Spalten und dann komm ich wieder nicht mehr klar, weil ich mit der Offset Funktion so meine Schwierigkeiten hab. Und zwar finde ich jetzt meine zu suchende Kostenstelle in Spalte B (2) ab Zeile 11 im Tabellenblatt Kopie und kopiere dann die Zeile in Spalte B ab Zeile 11 im Tabellenblatt Original. Wahrscheinlich total einfach, aber ich steh auf dem Schlauch. Es geht nur um die Verschiebung der Kopier und der Suchrange, soweit ich das richtig verstanden hab!
-------------------------------------------------------------------------
Folgendes Beispieldokument mit ein paar Kommentaren hab ich
  • letztes Mal
  • erstellt: https://www.herber.de/bbs/user/130569.xlsm
    Unendlich viel Dank an die- oder denjenigen, der mir hier raushilft!!!

    13
    Beiträge zum Forumthread
    Beiträge zu diesem Forumthread

    Betreff
    Datum
    Anwender
    Anzeige
    AW: Tabellenvergleich
    02.07.2019 16:43:31
    KathrinZ
    Der Code funktioniert auch immer noch wunderbar. Kopierbereich greift immer noch, nur der Einfügebereich ist der Falsche..
    Crossposting
    02.07.2019 17:46:41
    onur
    Entweder die Frage nur in EINEM Forum Stellen oder wenigstens in allen Foren erwähnen, in welchen Foren die selbe Frage noch gestellt wurde.
    AW: Tabellenvergleich
    02.07.2019 18:52:30
    Matthias
    Moin!
    Probiere es mal mit dem Code hier. Habe dein Original nur etwas abgewandelt.
    Dim wsOr As Worksheet, wsKo As Worksheet
    Dim Suchrange As Range, Kopierrange As Range
    Dim zeile As Long
    Set wsOr = ThisWorkbook.Worksheets("Tabelle1")
    Set wsKo = ThisWorkbook.Worksheets("Kopie")
    Set Kopierrange = wsKo.UsedRange.Columns(2).Offset(10, 0)
    For Each Zelle In Kopierrange.Resize(Kopierrange.Rows.Count - 10).Cells
    Set Suchrange = wsOr.Columns(2).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.Offset(0, -1)
    Zelle.EntireRow.Clear
    End If
    Next Zelle
    Set wsOr = Nothing
    Set wsKo = Nothing
    Set Kopierrange = Nothing
    

    VG
    Anzeige
    AW: Tabellenvergleich
    03.07.2019 08:13:33
    KathrinZ
    Hat mir einen Fehler geschmissen. Genau so hab ich ihn nämlich auch schon abgewandelt! Trotzdem danke Dir, habe in einem anderen Forum die Lösung gekriegt. http://www.vba-forum.de/forum/View.aspx?ziel=52191
    Und tut mir leid, dass ich das nicht verlinkt hatte, aber ich wusste nicht, dass ich es nicht in mehreren Foren posten darf.
    Vielen Dank auf jeden Fall und VG
    AW: Tabellenvergleich
    03.07.2019 16:28:34
    KathrinZ
    Hallo Matthias,
    kannst Du mir vielleicht noch kurz helfen?
    Ich denke dieser Code ist dem ganzen bis jetzt am nächsten gekommen, aber die Suchrange passt nicht ganz und wenn die nicht passt, fügt er mir die kopierte Zeile an der falschen Stelle ein.
    Sub Verteilen()
    Dim Suchrange As Range, Kopierrange As Range
    Dim zeile As Long
    Set wsOr = ThisWorkbook.Worksheets("Upload")
    Set wsKo = ThisWorkbook.Worksheets("Input ext.")
    Set Kopierrange = wsKo.UsedRange.Columns(2).Offset(9, 0)
    For Each Zelle In Kopierrange.Resize(Kopierrange.Rows.Count - 9).Cells
    Set Suchrange = wsOr.Columns(2).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(10, 0)
    Zelle.EntireRow.Clear
    Else
    Zelle.EntireRow.Copy Suchrange.Offset(10, -1)
    Zelle.EntireRow.Clear
    End If
    Next Zelle
    Set wsOr = Nothing
    Set wsKo = Nothing
    Set Kopierrange = Nothing
    End Sub
    

    Die Suchrange wird hier als die Zeile in Spalte 2 bestimmt, in der der Wert gefunden wird bzw. wenn er nicht gefunden wird, dann soll es in der Zeile nach der letzten beschriebenen Zeile eingefügt werden. Das funktioniert leider noch nicht ganz und es wird immer in der ersten Zeile eingefügt. Kannst du mir nochmal behilflich sein?
    VG Kathrin
    Anzeige
    AW: Tabellenvergleich
    03.07.2019 18:42:11
    Matthias
    Moin!
    Kein Problem.
    Hatte mit der alten Datei getestet und bei mir war kein Fehler. Wenn jetzt nochmal eine aufrtitt, einfach die Meldung / Fehlercode und die Zeile dazu mal posten.
    Um deinen Fehler zu umgehen, ändere mal die Zeile hier:
    Zelle.EntireRow.Copy wsOr.Cells(wsOr.Rows.Count, 1).End(xlUp).Offset(1, 0)
    

    in das hier:
    Zelle.EntireRow.Copy wsOr.Cells(wsOr.Rows.Count, 2).End(xlUp).Offset(1, 0)
    

    Da ist eigentlich aus der 1 nur eine 2 geworden. Das heißt, der Code nimmt die Letzte Zeile aus Spalte 2 ( = B ) und fügt eins darunter (offset) die Werte ein.
    VG
    Anzeige
    AW: Tabellenvergleich
    04.07.2019 08:07:05
    KathrinZ
    Ja das hab ich auch schon so probiert, aber dann kommt folgende Meldung:
    Laufzeitfehler '1004':
    Sie können dies hier nicht einfügen, da der Kopieren-Bereich und der Einfügebereich nicht die gleiche Größe haben.
    Wählen Sie im Einfügebereich nur eine Zelle oder einen Bereich mit der selben Größe aus, und versuchen Sie das Einfügen noch mal.

    AW: Tabellenvergleich
    04.07.2019 08:39:14
    KathrinZ
    Hab in einem anderen Beitrag gelesen, dass man die Range definieren soll in etwa so:
    Dim Einfuegerange As Range
    Set Einfuegerange = wsOr.Cells(wsOr.Rows.Count, 2).End(xlUp).Offset(1, 0)
    Zelle.EntireRow.Copy Einfuegerange
    
    Aber leider selbes Spiel - wieder Laufzeitfehler 1004...
    Anzeige
    AW: Tabellenvergleich
    04.07.2019 17:00:16
    Hajo_Zi
    frage jemand der neben Dir sitzt der sieht die Datei.
    Die meisten hier sehen Sie nicht.
    Da Sie nicht auf Deinen Rechner schauen.
    Vielleicht sollte die Datei verlinkt werden?
    Der Name einer hochgeladenen Mappe wird im Beitrag automatisch angezeigt, sodass es bei Verwendung von aussagekräftigen Namen leichter fällt, sie später im Ablageordner wiederzufinden und sie gedanklich einem bestimmten Thema zuzuordnen. Namen wie Muster*, Test*, Mappe*, Beispiel*, Fehler*, Kalender*, UserForm*, Forum* usw. sind so allgemein, dass eine Zuordnung zu einem Thema unmöglich gemacht wird.
    Es sollte ein aussagekräftiger Name sein.
    Benutze hier im Forum die Funktion zum hochladen. Falls Du die nicht benutzen möchtest beachte, von unsicheren Servern wie z.B. www.file-upload.net lade ich keine Datei runter. (lt. Einschätzung meines Virenprogramms)

    Beiträge von Werner, Luc, robert, J.O.Maximo und folgende lese ich nicht.
    Die Beiträge werden auch ignoriert, es erfolgt keine Antwort.
    Anzeige
    AW: Tabellenvergleich
    04.07.2019 17:24:21
    KathrinZ
    Das wäre folgende Datei:
    https://www.herber.de/bbs/user/130731.xlsm
    Ich hoffe alles ist verständlich. Kopiert werden sollen die Zeilen von Input ext. in das Upload Sheet. Wenn die Kostenstelle schon vorhanden ist, wird die Zeile im Uploade Sheet überschrieben. Wenn sie nicht existiert, soll sie in der Tabelle unten angefügt werden (entsprechend dem Code eigentlich, aber der schmeißt den Fehler mit ungleichen Bereichen).
    Vielen lieben Dank für Mithilfe! :-)
    LG Kathrin
    AW: Tabellenvergleich
    04.07.2019 18:07:42
    Hajo_Zi
    Hallo Katrin,
    ich habe erstmal auch keinen Grund warum das nicht gehen sollte.
    Ersatz
    Zelle.EntireRow.Copy Rows(Einfuegerange.Row)
    Gruß Hajo
    Anzeige
    AW: Tabellenvergleich
    04.07.2019 23:39:59
    Matthias
    Moin!
    Dann ändere mal die Zeile hier:
    Zelle.EntireRow.Copy wsOr.Cells(wsOr.Rows.Count, 2).End(xlUp).Offset(1, 0)
    

    in das hier
    Zelle.EntireRow.Copy wsOr.Cells(wsOr.Rows.Count, 2).End(xlUp).Offset(1, -1)
    

    Damit setzt du den Offset eine Zeile tiefer und eins nach links. Damit bist du wieder in Spalte A. Damit passen die verschiedenen Bereich zu einandern. ABer mal aufpassen. In Spalte B hast du auch in einigen Feldern Formeln drin - zumindest das Gleichheitszeichen. Dadurch entsteht ggf. einen leere Zeile. Die nicht notwendigen = Zeichen einfach löschen.
    VG
    Anzeige
    AW: Tabellenvergleich
    05.07.2019 09:01:10
    KathrinZ
    Also vielen Dank Euch beiden!
    Es funktioniert so und das mit den Formeln hab ich gerade bemerkt beim Testen. Da hat er mir dann angefangen in Zeile 10.000 einzufügen. Aber Workaround ist hier auch gefunden. Normalerweise ist mein Problem jetzt endgültig gelöst (hoffentlich!).
    VG
    Kathrin

    Links zu Excel-Dialogen

    Beliebteste Forumthreads (12 Monate)

    Anzeige

    Beliebteste Forumthreads (12 Monate)

    Anzeige
    Anzeige
    Anzeige