Vergleichen und Verschieben von Zeilen

26.05.2025 16:20:32

Mike

Hallo zusammen, ich veregleiche 2 Werte miteinander und möchte gerne per Makro folgendes erzielen: sofern der Wert von Spalte A zu Spalte B abweicht soll Spalte B um eine Zeile nach unten geschoben werden, gleiches gilt für Spalte A, sofern der Wert2 in Spalte B kleiner ist als Spalte A (zuvor sollte eine A-Z Sortierung der jeweiligen Spalten erfolgen). Habe eine Excel Beispieldatei mal beigefügt

bisher
Wert1 Wert2
XS123456789 XS123456789 (Zeile 3)
XS234567890 XS345678901 (Zeile 4)

neu
Wert1 Wert2
XS123456789 XS123456789
XS234567890
XS345678901 -->1 Zeile nach unten verschoben

https://www.herber.de/bbs/user/177583.xlsx

Vielen lieben Dank vorab für die Hilfe & Unterstützung,
Mike

AW: Vergleichen und Verschieben von Zeilen

26.05.2025 16:29:22

BoskoBiati

Hi,

als einfacher Ansatz.

Sub Zelle_schieb()



Dim loLast As Long

Dim loCo As Long

loLast = Cells(Rows.Count, 1).End(xlUp).Row

For loCo = loLast To 3 Step -1

    If Cells(loCo, 2) > Cells(loCo, 1) Then Cells(loCo, 2).Insert xlDown

Next

End Sub

Gruß

Edgar

AW: Vergleichen und Verschieben von Zeilen

26.05.2025 16:53:21

cysu11

Hallo Mike,

vielleicht so?

Sub VergleicheUndVerschiebe()

    Dim ws As Worksheet

    Set ws = ThisWorkbook.Sheets(1)

    Dim lrA As Long, lrB As Long, i As Long

    lrA = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row

    lrB = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row

    ws.Range("A3:A" & lrA).Sort Key1:=ws.Range("A3"), Order1:=xlAscending, Header:=xlYes

    ws.Range("B3:B" & lrB).Sort Key1:=ws.Range("B3"), Order1:=xlAscending, Header:=xlYes

    i = 3

    Do While i = lrA And i = lrB

        Dim valA As String, valB As String

        valA = ws.Cells(i, "A").Value

        valB = ws.Cells(i, "B").Value



        If valA > valB Then

            If valA  valB Then

                ws.Range("A" & i).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove

            Else

                ws.Range("B" & i).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove

            End If

        End If

        i = i + 1

    Loop

End Sub

LG, Alexandra

AW: Vergleichen und Verschieben von Zeilen

26.05.2025 17:31:53

daniel

Hi

in Excel 365 könnte man auch eine Formel verwenden:

=LET(
a;$A$1:$A$5;
b;$B$1:$B$5;
HSTAPELN(
TEXTTEILEN(TEXTVERKETTEN("-";0;WENN(a=b;a;WENN(a&ltb;a&"-";"-"&a)));;"-");
TEXTTEILEN(TEXTVERKETTEN("-";0;WENN(a=b;b;WENN(b&lta;b&"-";"-"&b)));;"-")
))

allerdings darf die Liste nicht sehr lang sein, da hier zuerst alle Zellen in einen Text geschrieben werden, darf die Anzahl der Zeichen über alle Zellen die zulässige Länge für einen Text in einer Zelle nicht überschreiten (c.a. 32.000)

AW: Vergleichen und Verschieben von Zeilen

26.05.2025 19:57:44

Yal

Moin,

ich schlage -wie fast immer- eine Lösung mit Powert Query vor. Ich gehe davon, dass die Reihenfolge unwesentlich ist. Wenn nicht müsste man einen Zusatz hinzufügen. Aber zuerst die einfache Variante:

- markiere den Bereich A1:B9, Menü "Einfügen", "Tabelle". Es wird erkannt, dass Überschrift vorhanden sind, wenn nicht anhaken.
- die Tabelle heisst "Tabelle1".
- rechtsklick auf die Tabelle "Daten aus Tabelle/Bereich abrufen..."
- wir sind in Power Query Editor
- Menü "Start", "Abfrage zusammenführen", "Abfragen als neue Abfrage zusammenführen"
- im mittleren Feld, dieselbe Abfrage "Tabelle1" als oben einstellen,
- unten in der erste Abfrage die Spalte "ISIN 1" und unten "ISIN 2" wählen,
- Join-Art auf "vollständiger äußerer Join" stellen, ok.
- die Spalte "ISIN 2" entfernen (rechstklick auf dem Spaltenüberschrift, dann "Entfernen")
- in der neue Spalte mit allen "Table" auf dem doppelte Pfeil klicken, alle Haken raus ausser bei "ISIN 2", unten Präfix auch raus.
- Menü "Datei", "Schliessen & laden in ...", "nur Verbindung herstellen"
- wir sind wieder in Excel klassisch
- in der Liste der Abfragen die zweite Abfrage "Zusammenführen1" rechtsklicken, "Laden in..."
- Erste Auswahl "Bericht" einstellen und passende Stelle im Blatt anklicken.
Fertig.

Wenn die Daten aus einer Textdatei kommen, geht es mit Power Query noch besser, weil direkt auf die Datei abgefragt werden kann: Menü "Daten", "Aus Datei", usw..

VG
Yal

AW: Vergleichen und Verschieben von Zeilen

27.05.2025 23:38:25

Mike

Hallo zusammen,

vielen Dank Euch für eure Rückmeldungen, ich habe hier nochmal eine Beispieldatei hochgeladen in der ersichtlich ist dass die Spalten A & J / "Identifikation" (in rot hervorgehoben) maßgeblich sind (siehe Tabellenblatt "Ausgangslage"), d.h. diese Spalten sollten alphabetisch geordnet werden und der Reihenfolge nach in die jeweiligen Zeilen verschoben werden sollen, je nachdem ob der Wert in Spalte A oder Spalte J kleiner ist (siehe hierzu Tabellenblatt "NEU").
Stichtag 1 umfasst die Spalten A-I und Stichtag 2 die Spalten J-R.
Ich hoffe es ist verständlich was ich geschrieben habe und suche ;-)

https://www.herber.de/bbs/user/177594.xlsx

Vielen herzlichen Dank im Voraus für die Rückmeldungen & Unterstützung
Gruß Mike

AW: Vergleichen und Verschieben von Zeilen

28.05.2025 14:09:52

cysu11

Hallo Mike,

dann so, hättest von Anfang an sagen können! ;)

Sub VergleicheUndVerschiebe()

    Dim ws As Worksheet

    Set ws = ThisWorkbook.Sheets("Ausgangslage")

    Dim lrA As Long, lrB As Long, i As Long

    lrA = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row

    lrB = ws.Cells(ws.Rows.Count, "J").End(xlUp).Row

    ws.Range("A2:I" & lrA).Sort Key1:=ws.Range("A2"), Order1:=xlAscending, Header:=xlYes

    ws.Range("J2:R" & lrB).Sort Key1:=ws.Range("J2"), Order1:=xlAscending, Header:=xlYes

    i = 3

    Do While i = lrA And i = lrB

        Dim valA As String, valB As String

        valA = ws.Cells(i, "A").Value

        valB = ws.Cells(i, "J").Value



        If valA > valB Then

            If valA  valB Then

                ws.Range("J" & i, "R" & i).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove

                lrB = lrB + 1

            Else

                ws.Range("A" & i, "I" & i).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove

                lrA = lrA + 1

            End If

        End If

        i = i + 1

    Loop

End Sub

LG, Alexandra

AW: Vergleichen und Verschieben von Zeilen

26.05.2025 17:30:31

Mike

Hallo Edgar & Alexandra,
vielen Dank Ihnen für die schnelle Rückmeldung und Hilfe. Sobald der erste Unterschied von Spalte A und B auftaucht kommt es zu einem Problem, ich habe hier nochmal die Werte aktualisiert um meine Fragestellung etwas zu konkretisieren. Die Werte in Spalte A und B sind alphabetisch sortiert, sobald es einen Unterschied in Spalte A oder B kommt soll die jeweilige Zelle verschoben werden. Ggfls sind in einer Spalte auch Werte doppelt oder mehrfach vorhanden

bisher
Wert1 Wert2
127247733 129262979
129262979 124169091
124169092 124169092
124169092 124169093
124169092 124169095
124169095 124169095
124169096 124169096

neu
Wert1 Wert2
127247733
129262979 129262979
124169091
124169092 124169092
124169092
124169092
124169093
124169095 124169095
124169095
124169096 124169096

https://www.herber.de/bbs/user/177584.xlsx

AW: Vergleichen und Verschieben von Zeilen

26.05.2025 18:15:18

cysu11

Hallo Mike,

dann so:

Sub VergleicheUndVerschiebe()

    Dim ws As Worksheet

    Set ws = ThisWorkbook.Sheets(1)

    Dim lrA As Long, lrB As Long, i As Long

    lrA = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row

    lrB = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row

    ws.Range("A2:A" & lrA).Sort Key1:=ws.Range("A2"), Order1:=xlAscending, Header:=xlYes

    ws.Range("B2:B" & lrB).Sort Key1:=ws.Range("B2"), Order1:=xlAscending, Header:=xlYes

    i = 3

    Do While i = lrA And i = lrB

        Dim valA As String, valB As String

        valA = ws.Cells(i, "A").Value

        valB = ws.Cells(i, "B").Value



        If valA > valB Then

            If valA  valB Then

                ws.Range("B" & i).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove

                lrB = lrB + 1

            Else

                ws.Range("A" & i).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove

                lrA = lrA + 1

            End If

        End If

        i = i + 1

    Loop

End Sub

https://www.herber.de/bbs/user/177585.xlsm

LG, Alexandra

AW: Vergleichen und Verschieben von Zeilen

26.05.2025 18:57:52

cysu11

P.S. Deine Sortierung in dein 2. Post stimmt nicht ;)

LB, Alexandra

AW: Vergleichen und Verschieben von Zeilen

26.05.2025 19:19:34

Mike

Hallo Alexandra, herzlichen Dank, es funktioniert super! :-)
Wie müsste ich den Code denn ändern wenn neben den Werten in Spalte A noch weitere dazugehörige Daten stehen und sozusagen die Vergleichsdaten erst ab Spalte N beginnen und in Spalte S aufhören, maßgeblich aber die Spalte ISIN ist?
Vielen Dank vorab für die Hilfe & Unterstützung
Mike

AW: Vergleichen und Verschieben von Zeilen

26.05.2025 19:23:02

cysu11

Hi Mike,

auch hier bitte Beispieldatei hochladen! :)

LG, Alexandra

AW: Vergleichen und Verschieben von Zeilen

26.05.2025 22:00:59

daniel

Hi
Beispieldatei wäre schön, aber ich probiers mal ohne.

Tabellenaufbau wie beschrieben, Teil 1 von Spalte A-M, Teil 2 von Spalte N-S
nicht wie beschrieben aber Standard: Zeile 1 ist Überschrift, ab Zeile 2 dann Daten.

zum Code, ich würde ihr die Zeilen nicht mit Einfügen verschieben, sondern ID-Nummern verwenden (wegen der Mehrfach vorkommenden Nummern, diese müssen eindeutig werden) und dann sortieren.

hier der Code dazu, du solltest im Einzelstepmodus durchgehen und anschauen, was passiert.

Sub test()

Dim x

Dim rng1 As Range

Dim rng2 As Range



Columns(14).Resize(, 3).Insert

Columns(1).Resize(, 2).Insert



Range("c1").CurrentRegion.Sort Key1:=Range("C1"), order1:=xlAscending, Header:=xlYes

Range("s2").CurrentRegion.Sort Key1:=Range("s2"), order1:=xlAscending, Header:=xlYes



For Each x In Array("c1", "s1")

With Range(x).CurrentRegion.Offset(1, -2).Resize(, 2)

    .Columns(1).FormulaR1C1 = "=IF(RC[2]=R[-1]C[2],R[-1]C+1,1)"

    .Columns(2).FormulaR1C1 = "=IF(RC[1]="""","""",RC[1]&Text(RC[-1],""-0000""))"

    .Formula = .Value

End With

Next



Set rng1 = Range(Cells(2, "B"), Cells(2, "B").End(xlDown))

Set rng2 = Range(Cells(2, "R"), Cells(2, "R").End(xlDown))



rng1.Copy rng2.Offset(rng2.Cells.Count, 0)

rng2.Copy rng1.Offset(rng1.Cells.Count, 0)



rng1.EntireColumn.RemoveDuplicates 1, xlYes

rng2.EntireColumn.RemoveDuplicates 1, xlYes



Range("C1").CurrentRegion.Sort Key1:=Range("b1"), order1:=xlAscending, Header:=xlYes

Range("S1").CurrentRegion.Sort Key1:=Range("R1"), order1:=xlAscending, Header:=xlYes





Range("P:R").Delete

Range("A:B").Delete





End Sub

Gruß Daniel

Vergleichen und Verschieben von Zeilen

Forumthread: Vergleichen und Verschieben von Zeilen

12
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Vergleichen und Verschieben von Zeilen

Forumthread: Vergleichen und Verschieben von Zeilen

12 Beiträge zum Forumthread Beiträge zu diesem Forumthread

12
Beiträge zum Forumthread

Beiträge zu diesem Forumthread