'Hulp gevraagd bij macro

[greetings]

Greetings,

ik importeer in excel textfiles. Dit levert 2 kolommen op: A en B. De A kolom toont herhalend aflopende reeksen (zeg van 1700 naar 600).

Het is de bedoeling dat de reeksen niet onder elkaar blijven staan, maar naast elkaar worden geplaatst. Dus eigenlijk elke keer dat een nieuwe reeks begint, wil ik kolom A en B van de voorgaande reeks selecteren, knippen, en in (bv) kolommen C en D plakken. Daarna weer een set selecteren en knippen en plakken in E en F, enzovoorts. Net zolang er geen reeksen meer onder elkaar staan. Het kan om een paar reeksen gaan, maar ook wel 200. De reeksen zijn telkens even lang (in dit geval: 1015 lines).

Ik dacht dit met een macro te doen, maar recording lukt mij niet. Wie weet raad?
Bijgaand een voorbeeld van een dergelijk bestand. Ik heb de eerste reeks een kleurtje gegeven.


Bekijk bijlage voorbeeld helpmij.xlsx

 

[Leotaxi]

macro overnemen in eigen bestand, heb op deze vanalles verwijderd
ongeveer zo ?

mvg
Leo

 

[greetings]

helemaal goed.
dank je wel!

 

[Warme bakkertje]

in dit geval: 1015 lines).

Wat ga je dan doen als je reeksen importeert die maar een lengte hebben van bv 500 lines. Telkens de macro handmatig aanpassen ?

 

[greetings]

Voor een paar reeksen is dat even niet anders. Zijn maar een paar handelingen.

Met de kennis van nu kan ik bij het genereren van mijn data wel zorg dragen dat er reeksen van 1015 lines ontstaan. Komt bij de verdere verwerking van de data trouwens ook goed van pas als de datareeksen onderling op elkaar aansluiten.

 

[snb]

Zonder knip- en plak-werkbladbewerkingen:

Sub M_snb()
    sn = Cells(1).CurrentRegion
    
    ReDim sp(1 To 1015, 1 To UBound(sn) \ 1015 + 1)
    
    For j = 1 To UBound(sn)
       sp((j - 1) Mod 1015 + 1, (j - 1) \ 1015 + 1) = sn(j, 1)
    Next
    
    Cells(1).CurrentRegion.ClearContents
    Cells(1).Resize(1015, UBound(sp, 2)) = sp
End Sub

 

[Leotaxi]

helemaal waar wat betreft die lengte die kan verschillen, effe overgezien
bij deze dan één waar je de lengte kan opgeven, en alles wordt naar blad 2 gesplitst.

mvg

Leo

 

[greetings]

Helemaal top.
ik probeer de macro's te volgen maar dat valt niet mee. Wat ik net ontdek is dat het voor verdere dataverwerking volstaat als ik de waarde in kolom A (dus van grofweg 1700 naar 600), maar 1 keer heb staan (in kolom A). Die wordt nu telkenmale mee gesplitst, maar zoals gezegd eigenlijk niet nodig. Hoe kan ik de macro zo bewerken dat alleen kolom B wordt gesplitst?

 

[Leotaxi]

hierbij aangepaste versie, met maar 1 malig reeks A en wat uitleg in macro

mvg
Leo

 

[greetings]

Geweldig.
Ik ga er eens op studeren.

 

[Warme bakkertje]

Zonder opgave van aantal lijnen. De unieke reeks wordt automatisch berekend.

Sub M_snb_WB()
    sn = Blad1.Cells(1).CurrentRegion
    
    With CreateObject("Scripting.Dictionary")
        For j = 1 To UBound(sn)
            x= .item(sn(j, 1))
        Next
    
        ReDim sp(1 To .Count, 1 To UBound(sn) \ .Count + 1)
    
        For j = 1 To UBound(sn)
            sp((j - 1) Mod .Count + 1, (j - 1) \ .Count + 1) = sn(j, 2)
        Next
    
        Blad2.Cells(1).CurrentRegion.ClearContents
        Blad2.Cells(1).Resize(.Count) = Application.Transpose(.keys)
        Blad2.Cells(1, 2).Resize(UBound(sp), UBound(sp, 2)) = sp
    End With
End Sub

 

[snb]

@WB

Not .exist is overbdig.

i.p.v.

With CreateObject("Scripting.Dictionary")
        For j = 1 To UBound(sn)
            If Not .exists(sn(j, 1)) Then .Add sn(j, 1), Nothing
        Next

gebruik

With CreateObject("Scripting.Dictionary")
        For j = 1 To UBound(sn)
            x=.item(sn(j, 1))
        Next

 

[Warme bakkertje]

@ snb
Het levert je zelfs 0.006 sec uitvoeringssnelheid op
0,072 tegen 0.078 voorheen.

 

[Leotaxi]

Ja, de kracht van VBA zeer mooi !
zelf heb ik daar nog maar 0,1 % kennis van
ga me er zeker in verdiepen.