AW: Passe
12.05.2006 09:05:22
Harald
Moin Peter,
oh mein Gott. Das geht garantiert eleganter. Bin mir sicher, das irgendein vba-Gott mir diesen Code abgrätscht ;-))
Wo was hinkommt, mußte aber selbst anpassen.
Sub HausmannskostdieZweite()
Dim i As Long, a As Long, b As Long, c As Long, d As Long, e As Long
'wenn absolut sicher ist, dass die Tabelle nicht mehr als 32000 Zeilen hat,
' ist es performanter, alle As Long Deklarationen in As Integer zu ändern
Application.ScreenUpdating = False
With Sheets("Quelle")
a = 1 'erste Zielzeile in Spalte 1 der Zieltabelle
b = 1 'erste Zielzeile in Spalte 2 der Zieltabelle
c = 1 'erste Zielzeile in Spalte 3 der Zieltabelle
d = 1 'erste Zielzeile in Spalte 4 der Zieltabelle
e = 1 'erste Zielzeile in Spalte 5 der Zieltabelle
For i = 1 To .Cells(Rows.Count, 1).End(xlUp).Row 'letzte gefüllte Zelle in Spalte 1 der Quelltabelle
If Left(.Cells(i, 1), 8) = " " Then 'wenn die ersten 8 Zeichen Leerstellen sind
Sheets("Ziel").Cells(a, 2) = Right(.Cells(i, 1), Len(.Cells(i, 1)) - 8) 'dann nach Spalte 1 ohne führende Leerstellen
a = a + 1
End If
If Left(.Cells(i, 1), 7) = " " Then 'wenn die ersten 5 Zeichen Leerstellen sind
Sheets("Ziel").Cells(b, 2) = Right(.Cells(i, 1), Len(.Cells(i, 1)) - 7) 'dann nach Spalte 2 ohne führende Leerstellen
b = b + 1
End If
If Left(.Cells(i, 1), 6) = " " Then 'wenn die ersten 5 Zeichen Leerstellen sind
Sheets("Ziel").Cells(c, 2) = Right(.Cells(i, 1), Len(.Cells(i, 1)) - 6) 'dann nach Spalte 3 ohne führende Leerstellen
c = c + 1
End If
If Left(.Cells(i, 1), 5) = " " Then 'wenn die ersten 5 Zeichen Leerstellen sind
Sheets("Ziel").Cells(d, 2) = Right(.Cells(i, 1), Len(.Cells(i, 1)) - 5) 'dann nach Spalte 4....
d = d + 1
End If
If Left(.Cells(i, 1), 2) = " " Then 'oder die ersten 2 Stellen Leerstellen sind
Sheets("Ziel").Cells(e, 1) = Right(.Cells(i, 1), Len(.Cells(i, 1)) - 2) 'nach Spalte 5...
e = e + 1
End If
Next i
End With
Application.ScreenUpdating = True
End Sub
Gruss Harald