Blockweises Verschieben
01.03.2019 11:16:56
Thomas
ich komme mit meinem Makro nicht weiter.
Ich will die ersten beiden Spalten zweier Blöcke nach folgenden 4 Bedingungen jeweils miteinander vergleichen und dementsprechen sortieren.
In der beigefügten Excel habt ihr zwei Beispiele:
https://www.herber.de/bbs/user/128017.xlsm
Selbst wenn ich auf beiden Seiten die gleichen Werte habe, verschiebt er iwas.
Wisst ihr vllt weiter?
Wäre super dankbar =)
Startzelle z.B. C12
1. Wenn in Zelle C12 Hinweis steht und im rechten Block in Zelle N12 eine Zahl, schiebe alle Werte im rechten Block eine Zeile nach unten
2. Wenn in Zelle C12 Hinweis steht und im rechten Block Zelle N12 ebensfalls Hinweis verschiebe den Block auf beiden Seiten nicht
3. Wenn in Zelle C12 eine Zahl enthalten ist, prüfe ob in Spalte N vorhanden ist und verschiebe anschließend den ganzen Block darunter auf die richtige Zeile wo beide Werte gleich sind
4. Ist in Zelle C12 eine Zahl entalten aber nicht im Spalte N vorhanden, verschiebe den rechten Block eine Zeile nach unten
Nachdem die Prüfung für Zelle C12 abgeschlossen ist, wird eine Zeile runtergesprungen in C13 und die gleichen Schritte werden ebensfalls angewendet...
Das ganze als Schleife bis die Tabelle endet oder ggf. Zeile 9999
Ziel ist es so 2 Blöcke die durch hinzufügen von Zeilen wieder auf gleiche Höhe zu bringen und die einzelnen Zeilen miteinander vergleichen zu können
Folgendes Makro habe ich:
Sub SortierungLV()
Dim letzteZeileC As Long
Dim letzteZeileN As Long
Dim i As Long
Dim suchBereich As Range
Dim suchErgebnis As Object
Dim ws As Worksheet
Dim zahl As Long
Dim zeile As Long
Dim zeileGefunden As Long
Dim zeilenDifferenz As Long
Set ws = ThisWorkbook.ActiveSheet
letzteZeileC = ws.Cells(ws.Rows.Count, "C").End(xlUp).Row
If letzteZeileC letzteZeileC
If ws.Cells(zeile, "C") = "*Hinweis*" And _
IsNumeric(ws.Cells(zeile, "N")) Then
' Fall 1
ws.Cells(zeile, "N").Resize(1, 11).Insert Shift:=xlDown
letzteZeileN = letzteZeileN + 1
ElseIf IsNumeric(ws.Cells(zeile, "C")) Then
' Suchen
Set suchBereich = ws.Range(ws.Cells(zeile, "N"), _
ws.Cells(letzteZeileN, "N"))
Set suchErgebnis = suchBereich.Find(What:=ws.Cells(zeile, "C"))
zeileGefunden = 0
If Not suchErgebnis Is Nothing Then
zeileGefunden = suchErgebnis.Row
End If
If zeileGefunden > 0 Then
' Fall 3
zeilenDifferenz = zeileGefunden - zeile
For i = 1 To zeilenDifferenz
ws.Cells(zeile, "C").Resize(1, 11).Insert Shift:=xlDown
Next i
zeile = zeile + zeilenDifferenz
letzteZeileC = letzteZeileC + zeilenDifferenz
Else
' Fall 4
ws.Cells(zeile, "N").Resize(1, 11).Insert Shift:=xlDown
letzteZeileN = letzteZeileN + 1
End If
End If
zeile = zeile + 1
Loop
End Sub