AW: Liste untereinander > nebeneinander
17.12.2014 12:47:48
yummi
Hallo Axel,
falls es etwas variabler sein soll, als die bisher vorgeschlagenen Lösungen nimm mal die beiden Makros und lass sie laufen
Das 1. Sortiert dir deien Artikel in die richtige Zeile und wenn alles so ist, wie du es haben willst, dann kannst du mit dem 2. die Artikel Zeilen löschen.
Ich weiß, hätte man auch in einem Schritt machen können, aber ist bewusst aufgeteilt ;-)
Option Explicit
Sub umsortieren()
Dim letztezeile As Long
Dim i As Long
Dim imerkezeile As Long
Dim imerkeSpalte As Integer
letztezeile = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
imerkeSpalte = 2
imerkezeile = 1
For i = 1 To letztezeile
If (InStr(1, ActiveSheet.Cells(i, 1).Value, "##", vbTextCompare) 0 Or InStr(1, _
ActiveSheet.Cells(i, 1).Value, "++", vbTextCompare) 0) Then
imerkezeile = i
imerkeSpalte = 2
Else
With ActiveSheet
.Range(.Cells(i, 1), .Cells(i, 1)).Copy .Range(.Cells(imerkezeile, imerkeSpalte) _
, .Cells(imerkezeile, imerkeSpalte))
End With
imerkeSpalte = imerkeSpalte + 1
End If
Next i
End Sub
Sub löscheArtikel()
Dim letztezeile As Long
Dim i As Long
Dim strRange As String
letztezeile = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
For i = letztezeile To 1 Step -1
If (InStr(1, ActiveSheet.Cells(i, 1).Value, "##", vbTextCompare) = 0 And InStr(1, _
ActiveSheet.Cells(i, 1).Value, "++", vbTextCompare) = 0) Then
strRange = i & ":" & i
ActiveSheet.Rows(strRange).Delete Shift:=xlUp
End If
Next i
End Sub
Gruß
yummi