Splitsen van cellen

[danny147]

Beste,

Graag zou ik cellen willen spltsen in 6 aparte cellen.

Met de volgende code lukt het voor 1 cel te splitsen, maar ik wil er meerdere.

Sub verdeel()
  [C1].Resize(, 6) = Split([A1])
End Sub

deze lukt niet:

Sub verdeel()
  [C3:C6].Resize(, 6) = Split([B3:B6])
End Sub

Groetjes Danny. :thumb:

 

[HSV]

Sub verdeel()
 For i = 3 To 6
  Cells(i, 3).Resize(, 6) = Split(Cells(i, 2))
 Next
End Sub

 

[danny147]

Beste HSV,

Bedankt voor de oplossing.

Groetjes Danny. :thumb:

 

[danny147]

Beste HSV,

Na het splitsen staan deze als tekst in de cel en wil deze als waarden hebben.

Wil volgende code gebruiken maar het lukt niet,
of kan bovenstaande code aangepast worden ?

Range("A1:A265").Copy
    Range("B1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False

Groetjes Danny. :thumb:

 

[HSV]

Zet het eens in een voorbeeldbestandje als je wil Danny.
Kan ik even zien wat je doet.

 

[danny147]

Beste HSV,

De bedoeling is dat ik 265720 LOTTO combinaties krijg in kolom A.
Deze kopieren en plakken als waarden in kolom B en kolom A verwijderen.
Dan omzetten in aparte cellen
Daarna waardes van maken.
Kolom A kan dan eventueel verwijderd worden.
Zodat deze cijfers gecontroleerd kunnen worden.

Bij het uitvoeren van de code kan het toch wat een tijdje duren totdat de code is uitgewerkt.
Deze kan enkel uitgevoerd worden in Excel 2007 of 2010 !

Groetjes Danny.

 

[HSV]

Dat duurd zeker een hele poos bij zoveel rijen.
Misschien is er een betere manier, maar zo lukt het wel.
Ik heb het even op 100 gezet.

Sub LOTTO()
With Application
  .ScreenUpdating = False
  .EnableEvents = False
[A1:A100].Formula = "=RandLotto(1,45,6)" '265720
 For i = 1 To 100
  Cells(i, 2).Resize(, 6) = Split(Cells(i, 1))
 Next
Range("IV1") = 1
 Range("IV1").Copy
   Range("B1:G" & Cells(Rows.Count, 7).End(xlUp).Row).PasteSpecial xlPasteValues, xlMultiply, False, False
        Range("IV1").ClearContents
    .Goto [A1]
    .CutCopyMode = False
    .EnableEvents = True
    .ScreenUpdating = True
  End With
 Columns(1).Delete
End Sub

 

[Warme bakkertje]

Wat denkt ge van 10 sec.

Sub tst()
Dim sq As Variant
t = Timer
ReDim sq(1 To 265720, 1 To 6)
For i = 1 To 265720
lBase = Split(RandLotto(1, 45, 6))
    For j = 1 To 6
        sq(i, j) = lBase(j - 1)
    Next
Next
Cells(1, 2).Resize(265720, 6) = sq
MsgBox Timer - t
End Sub

 

[sylvester-ponte]

je kan er beter geen formules in zetten maar alleen de getallen
als al die formules herberekend gaan worden kun je weer lang wachten.

ik vind daarom die van Rudi de mooiste oplossing.

groet sylvester

ps Rudi bij mij doet hij er 39 sec over, wat heb jij voor computer?

 

[Warme bakkertje]

Acer Aspire 7750G
x64-gebaseerde PC
Intel(R) Core(TM) i5-2450M CPU @ 2.50GHz, 2501 MHz, 2 core('s), 4 logische processor(s)
Geïnstalleerd fysiek geheugen (RAM) 8,00 GB
Microsoft Windows 7 Home Premium
Versie 6.1.7601 Service Pack 1 Build 7601
Office 2007
HD 1TB

 

[HSV]

Mooi gedaan Rudi.

Ik weet niet eens wat de snelheid bij Danny was, het duurde zolang dat ik het al zat was om dat ook nog eens te gaan testen.
Ik kom op een snelheid van ± 31,5.

 

[Warme bakkertje]

Ge moogt ook niet vergeten dat ge bijna 1.6 miljoen getallen moet wegschrijven, dus alles wat onder de minuut blijft heeft mi toch niet te klagen

 

[danny147]

Beste Warme bakkertje,

Dat is inderdaad kort van tijd.
Bij mij: 10,49 sec :thumb:

HSV, jij ook trouwens bedankt voor het zoeken.

Groetjes Danny. :thumb: