Bekijk bijlage Voorbeeld te splitsen getallen.xlsm
Beste Forumleden,
In het bijgevoegde bestandje staan wat er moet gebeuren.
De bedoeling is dat de getallen in kolom A gesplitst worden naar kolom B & C, in kolom B komen de eerste twee getallen van het getal in kolom a, in kolom C komt de rest.
Dit dient te gebeuren met een VBA code (dit is maar een onderdeel van het totaal aan VBA).
Nu heb ik gekeken of ik iets kon vinden aan een code die ik kan verbouwen naar mijn specifieke wensen, die heb ik helaas niet kunnen vinden of ik snap de code niet goed genoeg om deze aan te passen.
Deze code heb ik gevonden en iets aangepast, maar deze code kopieert alleen maar en splitst helemaal niet.
[XML]Sub splitsen()
Dim RE As Object
Dim MC As Object
Dim M As Object
Dim cell As Range
Dim doel As Range
Set RE = CreateObject("vbscript.regexp")
RE.Pattern = "([^0-9]+) (\d+) (\d+)"
RE.Global = True
For Each cell In Range([a1], [a60000].End(xlUp))
Set MC = RE.Execute(cell.Value)
If MC.Count Then
Set M = MC(0)
Set doel = Sheets("Blad1").[a60000].End(xlUp).Offset(1)
doel = M.submatches(0)
doel.Offset(0, 1) = M.submatches(1)
doel.Offset(0, 2) = M.submatches(2)
Else
Set doel = Sheets("Blad1").[b60000].End(xlUp).Offset(1)
doel = cell
End If
Next cell
End Sub[/XML]
Kan iemand mij helpen met dit probleem?
Beste Forumleden,
In het bijgevoegde bestandje staan wat er moet gebeuren.
De bedoeling is dat de getallen in kolom A gesplitst worden naar kolom B & C, in kolom B komen de eerste twee getallen van het getal in kolom a, in kolom C komt de rest.
Dit dient te gebeuren met een VBA code (dit is maar een onderdeel van het totaal aan VBA).
Nu heb ik gekeken of ik iets kon vinden aan een code die ik kan verbouwen naar mijn specifieke wensen, die heb ik helaas niet kunnen vinden of ik snap de code niet goed genoeg om deze aan te passen.
Deze code heb ik gevonden en iets aangepast, maar deze code kopieert alleen maar en splitst helemaal niet.
[XML]Sub splitsen()
Dim RE As Object
Dim MC As Object
Dim M As Object
Dim cell As Range
Dim doel As Range
Set RE = CreateObject("vbscript.regexp")
RE.Pattern = "([^0-9]+) (\d+) (\d+)"
RE.Global = True
For Each cell In Range([a1], [a60000].End(xlUp))
Set MC = RE.Execute(cell.Value)
If MC.Count Then
Set M = MC(0)
Set doel = Sheets("Blad1").[a60000].End(xlUp).Offset(1)
doel = M.submatches(0)
doel.Offset(0, 1) = M.submatches(1)
doel.Offset(0, 2) = M.submatches(2)
Else
Set doel = Sheets("Blad1").[b60000].End(xlUp).Offset(1)
doel = cell
End If
Next cell
End Sub[/XML]
Kan iemand mij helpen met dit probleem?