Sub Daten_()
Dim ArrayData, NewArr(), tmpArr, n&, nn&
With Tabelle1 'Tabelle evtl. anpassen
ArrayData = .Range("A2", .Cells(.Rows.Count, 1).End(xlUp))
Redim Preserve NewArr(1 To Ubound(ArrayData), 1 To 1)
For n = 1 To Ubound(ArrayData)
ArrayData(n, 1) = Replace(ArrayData(n, 1), " ", "")
If Len(ArrayData(n, 1)) > 4 Then
tmpArr = Split(ArrayData(n, 1), ".")
If Ubound(tmpArr) > 1 Then
nn = nn + 1
NewArr(nn, 1) = Format(tmpArr(0), "00") & "."
NewArr(nn, 1) = NewArr(nn, 1) & Format(tmpArr(1), "00") & "."
NewArr(nn, 1) = NewArr(nn, 1) & Format(tmpArr(2), "0000")
End If
End If
Next n
.Range("B1").Resize(.Rows.Count).Clear 'alte Daten löschen
.Range("B1").Resize(nn) = NewArr 'neue Daten einfügen
End With
End Sub
Sub Daten_()
Dim ArrayData, NewArr(), tmpArr, n&, nn&
With Sheets(1)
ArrayData = .Range("A1", .Cells(.Rows.Count, 1).End(xlUp))
ReDim Preserve NewArr(1 To UBound(ArrayData), 1 To 1)
For n = 1 To UBound(ArrayData)
ArrayData(n, 1) = Replace(ArrayData(n, 1), " ", "")
'Jetzt sollten die Zeilen mit weniger als 5 Zeichen in Spalte A gelöscht werden
'Hintergrund ist: in den folgenden Spalten steht auch noch was drin
If Len(ArrayData(n, 1)) > 4 Then
tmpArr = Split(ArrayData(n, 1), ".")
If UBound(tmpArr) > 1 Then
nn = nn + 1
NewArr(nn, 1) = Format(tmpArr(0), "00") & "."
NewArr(nn, 1) = NewArr(nn, 1) & Format(tmpArr(1), "00") & "."
NewArr(nn, 1) = NewArr(nn, 1) & Format(tmpArr(2), "0000")
End If
End If
Next n
.Range("A1").Resize(.Rows.Count).Clear 'alte Daten löschen
.Range("A1").Resize(nn) = NewArr 'neue Daten einfügen
End With
End Sub
Sub Daten_()
Dim ArrayData, tmpArr, tmpValue, n&
With Tabelle1 'Tabelle evtl. anpassen
ArrayData = .Range("A1", .Cells(.Rows.Count, 1).End(xlUp))
For n = 1 To Ubound(ArrayData)
tmpValue = ArrayData(n, 1)
ArrayData(n, 1) = Empty
tmpValue = Replace(tmpValue, " ", "")
If Len(tmpValue) > 4 Then
tmpArr = Split(tmpValue, ".")
If Ubound(tmpArr) > 1 Then
tmpValue = Format(tmpArr(0), "00") & "."
tmpValue = tmpValue & Format(tmpArr(1), "00") & "."
tmpValue = tmpValue & Format(tmpArr(2), "0000")
ArrayData(n, 1) = tmpValue
End If
End If
Next n
.Range("A1").Resize(Ubound(ArrayData)) = ArrayData 'neue Daten einfügen
.Columns(1).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End With
End Sub
Sub Umwandeln()
Const Spalte = 1, ZielSpalte = 3
Dim i As Integer
Dim lz As Long, z As Long, zarr
Dim z0 As String
Dim nz As Long
lz = Cells(Rows.Count, Spalte).End(xlUp).Row
For z = 1 To lz
z0 = Replace(Cells(z, Spalte).Text, " ", "")
If Len(z0) >= 5 Then
zarr = Split(z0, ".")
For i = LBound(zarr) To UBound(zarr)
zarr(i) = "0000" & zarr(i)
Next i
zarr(0) = Right(zarr(0), 2)
zarr(1) = Right(zarr(1), 2)
zarr(2) = Right(zarr(2), 4)
nz = nz + 1
Cells(nz, ZielSpalte) = zarr(0) & "." & zarr(1) & "." & zarr(2)
End If
Next z
End Sub
Sub c()
Dim R As Range
Columns(1).Replace " ", "", xlPart
Columns(1).NumberFormat = "general"
For Each R In Columns(1).SpecialCells(xlCellTypeConstants)
If Len(R) > 5 Then
R.Value = Format(Split(R.Value, ".")(0), "00") & "." _
& Format(Split(R.Value, ".")(1), "00") & "." _
& Format(Split(R.Value, ".")(2), "0000")
Else
R.ClearContents
End If
Next
Columns(1).SpecialCells(xlCellTypeBlanks).Delete
End Sub