Zelle Splitten
26.11.2015 01:42:25
Christoph
Habe das Makro mal erhalten.
Option Explicit
Sub splitCells()
Dim vntIn As Variant, vntOut() As Variant, vntTmp() As Variant, vntSplit As Variant, vntH As _
Variant
Dim lngI As Long, lngJ As Long, lngN As Long, lngM As Long
With Sheets("Tabelle2") 'Ausgabgstabelle - Anpassen!
vntH = .Range("A2:F1")
vntIn = .Range("A2:F" & Application.Max(2, .Cells(.Rows.Count, 1).End(xlUp).Row))
End With
Redim vntTmp(1 To 1, 1 To UBound(vntIn, 2))
For lngI = 1 To UBound(vntIn, 1)
vntSplit = Split(vntIn(lngI, 6), ",")
For lngN = 0 To UBound(vntSplit)
For lngJ = 1 To UBound(vntIn, 2) - 1
vntTmp(1, lngJ) = vntIn(lngI, lngJ)
Next
vntTmp(1, UBound(vntTmp, 2)) = vntSplit(lngN)
lngM = lngM + 1
Redim Preserve vntOut(1 To lngM)
vntOut(lngM) = vntTmp
Next
Next
vntOut = Application.Transpose(Application.Transpose(vntOut))
Worksheets.Add
With ActiveSheet
.Columns(6).NumberFormat = "0"
.Range("A1").Resize(1, UBound(vntH, 2)) = vntH
.Range("A2").Resize(UBound(vntOut), UBound(vntOut, 2)) = vntOut
.Columns.AutoFit
End With
End Sub
Habe das Problem das wenn es 5-6 Zahlen sind in einer Zelle gibt es kein Problem.Wenn es aber 8 oder mehr Zahlen sind die gesplittet werden müssen bricht das Makro immer ab mit Fehler.
Kann mir da eventuell jemand weiter helfen?