und vervollständige das Ergebnis dann selbst :)
Hinweis:
- alles steht in Spalte A im Arbeitsblatt 1
- Ergebnis steht dann im Arbeitsblatt 2
Musst also sicherstellen, dass diese beiden Bedingungen erfüllt sind
Option Explicit
Sub Test01()
Dim i As Long, ii As Long
Dim vRaw
Dim v1
Dim v2
Dim v3
vRaw = ThisWorkbook.Worksheets(1).Range("A1:A12") '<--- anpassen
ReDim v1(1 To UBound(vRaw, 1), 1 To UBound(vRaw, 2))
ReDim v2(1 To UBound(vRaw, 1), 1 To UBound(vRaw, 2))
ReDim v3(1 To UBound(vRaw, 1), 1 To UBound(vRaw, 2))
For i = LBound(vRaw, 1) To UBound(vRaw, 1)
For ii = LBound(vRaw, 2) To UBound(vRaw, 2)
Select Case Len(vRaw(i, ii)) - Len(LTrim(vRaw(i, ii)))
Case Is = 0
v1(i, ii) = vRaw(i, ii)
v2(i, ii) = vbNullString
v3(i, ii) = vbNullString
Case Is = 3
v1(i, ii) = vbNullString
v2(i, ii) = vRaw(i, ii)
v3(i, ii) = vbNullString
Case Is = 7
v1(i, ii) = vbNullString
v2(i, ii) = vbNullString
v3(i, ii) = vRaw(i, ii)
End Select
Next ii
Next i
With ThisWorkbook.Worksheets(2) '<--- anpassen
.Range("A1").Resize(UBound(v1, 1), UBound(v1, 2)).Value = v1
.Range("B1").Resize(UBound(v2, 1), UBound(v2, 2)).Value = v2
.Range("C1").Resize(UBound(v3, 1), UBound(v3, 2)).Value = v3
End With
End Sub
|