[excel] Transposemacro copypaste bereik aanpassen*

[Verwijderd]

Voor een enorme serie met verticaal geplaatste records ben ik beziggeweest een macro te schrijven die alles perfect horizontaal verwerkt dus veld A1=naam, A2=adres, A3=postcode, A4=plaats, A5=telefoon nummer etc etc etc...

de macro die ik geschreven heb moet eigenlijk voro elke record een nieuwe run hebben waarin de variabelen 'select' en 'copy' etc etc automatisch de volgende waarde hebben.

weet iemand misschien met welk soort macro ik dit kan doen?

Visual Basic:

Range("A1:A7").Select
    Selection.Copy
    Range("B1").Select
    Selection.PasteSpecial Paste:=xlAll, Operation:=xlNone, SkipBlanks:=False _
        , Transpose:=True
    Range("A1:A7").Select
    Application.CutCopyMode = False
    Selection.ClearContents
    Range("A10:A23990").Select
    Selection.Cut
    Range("A2").Select
    ActiveSheet.Paste

-----
Het idee is dat het 2e verticale blok niet over het eerste bewerkte (nu horizontaal staande) blok wordt heen geschreven maar op B2 komt...

Weet iemand hoe dit moet?

[ Voor 6% gewijzigd door Lustucru op 31-08-2005 23:17 ]

[Lustucru]

Omdat 'nog complexere transpose' niet zoveel zegt hebt ik je titel even aangepast.

Met behulp van cells(rij,kolom) kun je makkelijk velden e/o ranges aanduiden met numerieke variabelen.
Vervolgens zet je je code in een loopje waarin telkens de juiste waarden aan de variabelen worden meegegeven.
M.a.w. zoek even in de helpfile van excell naar het rangeobject en naar cells().

Wil je ook voor code de '[code]' tags gebruiken? Dat leest wat makkelijker

offtopic:
en welkom op GOT

[ Voor 11% gewijzigd door Lustucru op 31-08-2005 23:31 ]

[onkl]

Probeer dit eens.

Visual Basic:

Sub test()
For i = 1 To 5 'even klein houden voor testen, maar moet je aantal records worden.
    ActiveSheet.Range(Cells(i * 7 - 6, 1), Cells(i * 7, 1)).Copy
    ActiveSheet.Range(Cells(i, 2), Cells(i, 2)).Select
    Selection.PasteSpecial Paste:=xlAll, Operation:=xlNone, SkipBlanks:=False _
        , Transpose:=True
Next i
End Sub

[Verwijderd]

Haaaa , dit ziet er bijna goed uit, alleen wordt het een raar chaotisch zooitje,

het aanpassen van deze laatste macro lukt me niet echt, mijn records zien er verticaal zo uit:

Naam Bedrijf
Straat 1
1000 AA AMSTERDAM
020 00000000
020 00000000
[e-mail]
www.url.com
(dan twee regels wit en dan volgende record) en dit tot regel 24000

Kunt u mij vertellen hoe ik de macro hierop kan aanpassen?

[onkl]

Hieperdepiep, ze zeggen U tegen me.:)
Het gedachtenpatroon is vrij simpel. Eerst maak je een reeks van je eerste cellen. dat was in mijn voorbeeld (A)1, (A)8, (A)15. In jou geval zou het denk ik 1, 10, 19 etc zijn. Mijn voorbeeld repeteert per 7. Dus i*7. Dan nog een vaste compensatiewaarde eraanplakken. Eerste record begint op rij 1, niet op 1*7=7, -6 erachteraan en klaar ben je.
jij zou denk ik op i*9-8 komen.
Zelfde voor de laatste cellen(bij mij i*7), voor jou waarschijnlijk i*9-2 en klaar ben je.

[Verwijderd]

het systeem opzich werkt nu perfect! super, alleen is het probleem dat in mijn oude bestand sommige verticale records tóch niet uit 7 regels maar hier en daar uit 5 of minder regels bestaan omdat er hier en daar gegevens missen. dus springt het verhaal over, dit maakt te boel nog iets complexer .. arrrghh..

bestaat er een mogelijkheid om een macro te schrijven die in de verticale A kolom in plaats van 'gestuurd' het volgende blok selecteerd, dynamischer het volgende blok zelf opzoekt, als in,

startend op A1-> transpose op B1. en dan bij het herstarten van de loop, het eerst geselecteerde blok (het oude) eerste blok, de gegevens linksboven die er nog staan (van ongev. A1:A7), weggooit en per regel kijkt of het ergens een nieuw 'blok' opzich tegenkomt in de A kolom,

ik krijg er koppijn van

een hele andere optie denk ik, is om het hele geval te converteren naar csv en elk blok te markeren met bijv. een $ teken, maar dan zit ik met een bijna identiek probleem, (bestaat er de mogelijkheid om onder elk blokl automatisch een dollarteken te plaatsen?

[onkl]

Visual Basic:

Sub test()
Dim leescel As Range
Dim begincel As Range
Dim eindcel As Range
Dim plakcel As Range
Dim op As Boolean
Dim gevonden As Boolean
op = False
gevonden = False
Set leescel = ActiveSheet.Cells(1, 1)
Set plakcel = ActiveSheet.Cells(1, 2)
'zoek begincel
Do While op = False
    For i = 0 To 5
    gevonden = False
        If Not (leescel.Offset(i, 0).Value = "") Then
            Set leescel = leescel.Offset(i, 0)
            Set begincel = leescel
            i = 5 'beeindig loop
            gevonden = True
        End If
    op = Not (gevonden)
    Next i
    'zoek eindcel
    Set eindcel = begincel.Offset(9, 0) 'maximum van een record is 9, daar vast neerzetten.
    For i = 0 To 9
        If leescel.Offset(i, 0).Value = "" Then
            Set leescel = leescel.Offset(i, 0)
            Set eindcel = leescel.Offset(-1, 0)
            i = 9 'beeindig loop
        End If
    Next i
    Set leescel = eindcel.Offset(1, 0) 'als maximum
    'copy en paste
    ActiveSheet.Range(begincel, eindcel).Copy
    plakcel.Select
    Selection.PasteSpecial Paste:=xlAll, Operation:=xlNone, SkipBlanks:=False _
        , Transpose:=True
    Set plakcel = plakcel.Offset(1, 0)
Loop
End Sub

De variabele leescel loopt zo'n beetje je hele rij af terwijl er in die loop wordt gesocht naar het begin en eind van ieder record.

[Lustucru]

onkl schreef op donderdag 01 september 2005 @ 14:13:
[...]
De variabele leescel loopt zo'n beetje je hele rij af terwijl er in die loop wordt gesocht naar het begin en eind van ieder record.

Daar heeft excel het mooie currentregion voor.
Het onderstaande doet min of meer hetzelfde maar is wat korter

Visual Basic:

Sub test()
   Dim rangeAA As Range, bron As Range
   Dim bronrij As Long, doelrij As Long, laatsterij As Long
   
   'bovenaan beginnen
    bronrij = 1
    doelrij = 1
   
   'bronbereik afbakenen tot 1 kolom
   Set rangeAA = ActiveSheet.Range("A:A")
      
   'zoek de laatst ingevulde rij op, om te weten wanneer we klaar zijn!
   laatsterij = rangeAA.SpecialCells(xlCellTypeLastCell).Row
   
   While bronrij < laatsterij
        'record is aaneengesloten gebied
        Set bron = rangeAA.Cells(bronrij, 1).CurrentRegion
        bronrij = bronrij + bron.Rows.Count
        bron.Copy
        
        'dat wordtgetranponeerd
        ActiveSheet.Cells(doelrij, 2).PasteSpecial , , , True
        doelrij = doelrij + 1
        
        'even doorbladeren tot we de volgende niet lege cel tegenkomen
        'of voorbij de laatste rij zijn
        While rangeAA.Cells(bronrij, 1) = "" And bronrij <= laatsterij
            bronrij = bronrij + 1
        Wend
    Wend
End Sub

[onkl]

Niesje schreef op donderdag 01 september 2005 @ 14:38:
[...]


Daar heeft excel het mooie currentregion voor.
Het onderstaande doet min of meer hetzelfde maar is wat korter

Overduidelijk netter, TS, doe me 'n lol en skip mijn opzetje meteen maar.

[Verwijderd]

mad respect voor de maker van het laatste stukje!!! geweldig! prachtig!

mijn dank is groot!