[VBA] Sneller kopiëren in Excel

[Verwijderd]

Ik loop vast op de snelheid waarmee excel kopieert. Ik lees een bepaald bestand in, dat wil ik vervolgens gaan sorteren op verschillende andere sheets. Daartoe laat ik excel door de sheet zoeken en bepaalde cellen kopieren naar andere cellen in een andere worksheet.
Maar dit gaat dus veeeeeeel te langzaam, ik heb ook geprobeerd om eerst een array te vullen en als die vol zit weg te schrijven maar dit maakt voor de snelheid ook niets uit.

Het gaat over enkele tienduizenden cellen en ik heb hem nog nooit tot het eind kunnen laten doorlopen.

Een deel van de code zoals ik deze nu gebruik:

Visual Basic:

Sub organize()
Node = 1
For n = 1 To 60000

    If Range("A1").Offset(n, 0).Value = "NODE" Then
        Range("C1:E1").Offset(n, 0).Value.copy Worksheets("nodes").Range("B1:D1").Offset(Node, 0).Value
        Node = Node + 1
    End If

Next n
End Sub

Edit:
Al vast bedankt voor jullie reacties en sorry voor mijn slechte topic.
De code heb ik veranderd naar de versie zonder dat ik het in een array gooi.
Nog even als toevoeging. Het zoeken gaat relatief snel, maar ik zal Find en Find next uitproberen. Ik weet verder niet hoe ik het zonder offset zou moeten regelen omdat ik de range waar het naartoe moet niet van te voren weet
Een range kopieren is niet mogelijk omdat de gevonden waarden niet onder elkaar staan. Er miste een regel in de code

[ Voor 39% gewijzigd door Verwijderd op 10-09-2007 10:48 . Reden: Toch apart hoe veel mensen wel de [small]-tag weten te vinden, maar niet de [code]-tag. :P ]

[RobIII]

Voor code hebben we code tags

[NMe]

Waar hoort mijn topic?

PRG>>OFF

Overigens: Hoe post je code? / Hoe gebruik je de code tag?

[ATS]

Als ik je code zo zie, dan is je eerste stap om te zoeken naar het woord NODE in de range A1:A60000. In plaats van het doorlopen van elke cel, kan je natuurlijk beter gebruik maken van de functionaliteiten van Excel zelf. Excel biedt daarvoor in VBA de Find en FindNext methods. Bij Find staat in de documentatie een voorbeeld hoe je kan doen wat je wil. Dat is vast sneller.

Daarna wil je de waarden die je vindt opslaan op een andere sheet. De manier waarop je dat nu doet zorgt er in elk geval voor dat je gevonden waarden (50*m)+1 t/m 50*(m+1) niet opgeslagen worden. Dat is vast niet de bedoeling. Bovendien zie ik niet waar je de variabele "bulk" vandaan haalt. Waarom gebruik je de Reeks array überhaupt? Waarom niet direct naar de andere sheet schrijven? Daarnaast: waarom maak je gebruik van .Offset, en gebruik je niet direct de juiste range ("A5643")?

[Maasluip]

Ik vind het ook erg vreemd hoe je kopieert. Je slaat elke cel afzonderlijk op en kopieert die afzonderlijk. Heb je daar een bepaalde reden voor (misschien wil je alleen tekst kopieren)?

Ik zou voor kopieren altijd iets als dit gebruiken:

code:

Range("A1:A24").Copy
Range("C1").Select
ActiveSheet.Paste

Wil je alleen tekst of alleen opmaak kopieren dan is er altijd nog .PasteSpecial

[ Voor 13% gewijzigd door Maasluip op 10-09-2007 09:47 ]

[ATS]

Maasluip schreef op maandag 10 september 2007 @ 09:46:
Ik vind het ook erg vreemd hoe je kopieert. Je slaat elke cel afzonderlijk op en kopieert die afzonderlijk.

Mwah, dát snap ik nog wel. Hij wil alleen waardes copieren uit kolom B als daarvoor in kolom A het woord "NODE" staat (tenminste, dat maak ik op uit de code). Die moeten dan vervolgens netjes onder elkaar komen te staan.

edit:
@TS: reageer aub niet in je openingspost, maar gewoon met een nieuwe reply. Dit is bijzonder onduidelijk, en haalt ook context weg uit het archief. De edit functie is om kleine verbeteringen cq toevoegingen te maken, niet om een complete dialoog mee te voeren.

Ik weet verder niet hoe ik het zonder offset zou moeten regelen omdat ik de range waar het naartoe moet niet van te voren weet

Die range is gewoon een string. Je kan dus met behulp van string concatenation (=aan elkaar plakken) een string maken die er direct goed uit ziet. Is vast wat sneller.

[ Voor 39% gewijzigd door ATS op 10-09-2007 10:57 ]

[Verwijderd]

ik heb mijn topicstart even aangepast. Het is eigenlijk de eerste code waarmee ik begon voordat ik begon met experimenteren met arrays enzo. Ten opzichte van de vorige code kopieer ik nu 3 cellen, maar dat heeft er meer mee te maken omdat ik dingen aan het uitproberen was bij die array code.

[Maasluip]

ATS schreef op maandag 10 september 2007 @ 10:51:
[...]

Mwah, dát snap ik nog wel. Hij wil alleen waardes copieren uit kolom B als daarvoor in kolom A het woord "NODE" staat (tenminste, dat maak ik op uit de code). Die moeten dan vervolgens netjes onder elkaar komen te staan.

Dat stond er volgens mij niet. Ik las "zoeken naar NODE" en dan in batches van 50 alles wat er onder staat kopieren (tot 6000).

Maar goed, ik heb de code nu niet meer liggen, dus ik kan niet meer controleren of ik iets verkeerd heb gelezen.

En nog altijd: waarom offset gebruiken? Waarom niet ActiveSheet.Cells(n + 1, 1).Value?
Je werkt helemaal niet relatief dus kun je net zo makkelijk de absolute referentie gebruiken.

Probeer eens met een macro de handelingen op te nemen die je doet om te kopiëren. Want de code die je nu hebt staan werkt helemaal niet.

[ Voor 21% gewijzigd door Maasluip op 10-09-2007 11:14 ]

[Verwijderd]

de macro werkt wel, maar dan te langzaam. Ik zal vandaag verder experimenteren met de opmerkingen die jullie hier gemaakt hebben.

[ATS]

Maasluip schreef op maandag 10 september 2007 @ 11:07:
Ik las "zoeken naar NODE" en dan in batches van 50 alles wat er onder staat kopieren (tot 6000).

Maar goed, ik heb de code nu niet meer liggen, dus ik kan niet meer controleren of ik iets verkeerd heb gelezen.

Ik dacht dat er de gevonden resultaten alleen gebuffered werden en als de buffer vol was naar de andere sheet geschreven werden, maar ook ik kan dat niet meer controleren...

En nog altijd: waarom offset gebruiken? Waarom niet ActiveSheet.Cells(n + 1, 1).Value?

Dat is uiteraard nog een stuk beter dan met string concatenation een B5363 gaan lopen construeren. Ik wist dat dat moest kunnen, maar zag het zo snel niet in de documentatie.

[sopsop]

Je screenupdating uitzetten tijdens het uitvoeren van je macro wil nog wel eens snelheidsverhogend werken.

[Verwijderd]

bedankt voor de reacties, mochten jullie de oude code nog willen zien. Zit 1 wijziging in in regel 21, nodenr --> bulk

code:

Sub organize3()
    
Dim Reeks(1 To 50) As Integer


knoopnr = 1
bulk = 0
    
    For n = 1 To 60000
        If Range("A1").Offset(n, 0) = "NODE" Then
           
           Reeks(knoopnr) = Range("B1").Offset(n, 0)
           knoopnr = knoopnr + 1
                   
           If knoopnr = 51 Then
                For knoopnr = 1 To 50
                Worksheets("Nodes").Range("A1").Offset(knoopnr + bulk * 50, 0).Value = Reeks(knoopnr)
                Next knoopnr
        
                knoopnr = 1
                bulk = bulk + 1
                
            End If
        End If
    Next n
End Sub

[Bolukan]

Waar denk je dat de tijdwinst zit als je eerst cellen 1 voor 1 in een array bewaart en dan vervolgens 50 stuks een voor een weer in een andere cel stopt?

Als je veelvuldig cellen plakt, zorg dan dat je Application.Calculation op xlCalculationManual zet !

Mijn idee: Zet de te kopieren cellen in een range (middels UNION, eventueel in combinatie met Find/Findnext) en dan de hele range in een keer selecteren/kopieren naar de nieuwe sheet.

[Bolukan]

Zoiets

Visual Basic:

Public Sub ZoekEnKopieer()
Const STRING_ZOEK As String = "Test"
Dim rngTeKopieren As Range
Dim ZoekInKolom As Range
Dim Gevonden As Range
Dim EerstGevonden As Range

 ' Initialise
 Set ZoekInKolom = ActiveSheet.Columns(1)
 Set Gevonden = ZoekInKolom.Find(What:=STRING_ZOEK, LookIn:=xlFormulas, _
     LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
     MatchCase:=False, SearchFormat:=False)
 
 If Gevonden Is Nothing Then
    MsgBox "Error: Geen '" & STRING_ZOEK & "' gevonden!"
    End
 End If

 ' Selecteer cel B (Offset=1) tm D (Resize=3)
 Set rngTeKopieren = Gevonden.Offset(0, 1).Resize(1, 3) ' Hieronder nog een keer!
 Set EerstGevonden = Gevonden
 
 ' Herhaal tot alles is gevonden
 Set Gevonden = ZoekInKolom.FindNext(Gevonden)
 While Intersect(EerstGevonden, Gevonden) Is Nothing
    Set rngTeKopieren = Union(rngTeKopieren, Gevonden.Offset(0, 1).Resize(1, 3))
    Set Gevonden = ZoekInKolom.FindNext(Gevonden)
 Wend
 ' etc voor kopieren
 rngTeKopieren.Select
 
End Sub

Edit:
Een test met circa 6000 regels:
* Met Find: 180 seconden
* Met For-Next: 183 seconden
* Met sorteren (Dido-methode): 1 seconde
Toelichting: Door Union neemt de tijd exponentieel kwadratisch toe.

[ Voor 9% gewijzigd door Bolukan op 11-09-2007 16:49 ]

[Dido]

Een hele domme... als je eerst je data sorteert op dat veld waar "NODE" in moet staan, en vervolgens in 1 keer de hele range kopieert? Lijkt me dat dat veel sneller gaat dan 1 voor 1 je rijen eruit vissen?

[Verwijderd]

mss zou het nog sneller kunnen als over het volledig bereik programmatorisch in een aantal tijdelijke kolommen een als(cel="node");cel;"") wordt geplaatst en dan ofwel kopieren naar nieuw bereik of formules overschrijven met hun waardes. zou het geheel kunnen terugbrengen <10sec.

[Dido]

<10? We zaten al op <1 volgens Bolukan hierboven

En simpelweg sorteren lijkt me eenvoudiger dan dynamisch een paar hulpkolommen vullen

[Verwijderd]

Tot nu toe met andere dingen bezig geweest, maar ik ga dat sorteren morgen zeker proberen en dat moet wel kunnen werken volgens mij. Nogmaals bedankt voor jullie reacties en ik zal morgen mijn bevindingen posten.

[Verwijderd]

Jongens het is gelukt,
ik sorteer nu Nodes, Beams, Forces, Moments, Displacement en Rotations binnen 30sec. Hierbij staat de calculation nog aan. Als ik handmatig laat calculeren doet hij er slechts 18sec over. Beide resultaten zijn meer dan snel genoeg dus ik ben super blij.
Bedankt voor jullie hulp.

[F_J_K]

Maasluip schreef op maandag 10 september 2007 @ 11:07:
Probeer eens met een macro de handelingen op te nemen die je doet om te kopiëren. Want de code die je nu hebt staan werkt helemaal niet.

offtopic:
Macro-opnemen vind ik bij zoiets niet de handigste manier. Zo is copy/paste gebruiken alleen bij handmatig werken nodig of handig: 'Cells(i, j).Value = Cells(k, l).Value' is dan IMHO beter.
Hier gaat het meer om de juiste algoritmes gebruiken en dat gaat beter op papier dan met de opneemknop. Maar dat is een metadiscussie voor een ander topic

En inderdaad helpt screenupdate en (als dat kan) calculation uit- en na afloop aanzetten ook al behoorlijk.

[ Voor 3% gewijzigd door F_J_K op 12-09-2007 10:12 ]