In Excel kan je dat manueel bekomen door de eerste rij (groen) te kopiëren en vervolgens ‘Transponeren’ te kiezen via ‘Plakken Speciaal’.

Als je deze actie in VBA opneemt, krijg je volgend resultaat:

Range(“A1:E1”).Select
Selection.Copy
Range(“G1”).Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True

Een opgekuiste versie van deze code is:

Range(“A1:E1”).Copy
Range(“G1”).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True

Met VBA zou je deze actie 10 000 keer kunnen herhalen voor elke rij uit de reeks. In de volgende stappen leg ik uit hoe je dit met VBA kan uitvoeren. Er wordt telkens een indicatieve uitvoeringstijd getoond om daarna met een aanpassing van de VBA-code steeds sneller tot een resultaat te komen.

Gegevens kopiëren en plakken wordt door het operating system (Windows) afgehandeld waardoor je in dit voorbeeld 10 000 keer met een externe applicatie moet communiceren. Één cel/gebied kopiëren en plakken duurt maar een fractie van een seconde. Het kopiëren van 5 cellen duurt dus praktisch even lang als het kopiëren van 10 000 cellen, maar als je 10 000 keer vraagt om 5 cellen te kopiëren, moet je de uitvoertijd maal 10 000 doen.

In het onderstaande voorbeeld wordt de opgenomen macro 10 000 keer uitgevoerd. Er zijn ook wat variabelen voorzien om makkelijker met de rij/kolom tellers om te gaan. De uitvoertijd die vermeld wordt, is vastgelegd met mijn laptop en dient enkel om verhoudingen tussen de verschillende voorbeelden aan te tonen. De uitvoertijd op je eigen computer kan afwijken maar de verhouding zou gelijkaardig moeten zijn.

Sub Ex1_CopyTranspose()
Dim xRow As Long    ‘ RowCounter for row 1 till 10000
Dim dRow As Long    ‘ Destination Row
Debug.Print Now
dRow = 1
For xRow = 1 To 10000 Step 1
Range(Cells(xRow, 1), Cells(xRow, 5)).Copy
Cells(dRow, 7).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
dRow = dRow + 5
Next xRow
Debug.Print Now
‘Code Execution : 06:05 min
End Sub

Opmerking: De code ‘Debug.print Now’ toont de tijd bij het begin en het einde van de uitvoering. Om het resultaat te kunnen zien, toon je in Visual Basic het ‘Venster Direct’ (Debug Window). Dit kan met de toetsencombinatie ‘CTRL + G’.

In dit eerste voorbeeld heeft Excel meer dan 6 minuten nodig om alle rijen als een aparte kolom onder elkaar te plakken.

In het volgende voorbeeld voegen we 2 gekende rijen code toe die Excel verplichten om tijdens de uitvoering van de code het scherm niet te hertekenen maar te wachten tot het resultaat compleet is. Dit levert een grote snelheidswinst op bij het uitvoeren van je VBA code. De reden waarom ik dit nu pas toevoeg wordt in de volgende voorbeelden duidelijk.

Dit doe je met de code: Application.ScreenUpdating = False in het begin van een (stuk) code en Application.ScreenUpdating = True op het einde van een (stuk) code.

Sub Ex2_CopyTranspose()
Dim xRow As Long    ‘
Dim dRow As Long    ‘ Destination Row
Debug.Print Now
Application.ScreenUpdating = False
dRow = 1
For xRow = 1 To 10000 Step 1
Range(Cells(xRow, 1), Cells(xRow, 5)).Copy
Cells(dRow, 7).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
dRow = dRow + 5
Next xRow
Application.ScreenUpdating = True
Debug.Print Now
‘Code Execution : 01:11 min
End Sub

Opgelet: Deze code werkt op ‘application’ niveau, en als je vergeet om de ‘refresh’ terug aan te zetten (true) in de code zal Excel daarna geen wijzigingen meer uitvoeren op het scherm. Je kan de tekst ‘Application.ScreenUpdating = True’ ook uitvoeren vanuit het ‘venster direct’ (CTRL+G in VBA).

Door het toevoegen van de ‘Screenupdating’ halen we een mooie snelheidswinst. De uitvoertijd wordt van ongeveer 6:05 minuten herleid naar een uitvoertijd van 1:11 minuut. Merk hier op dat we nog steeds 10 000 keer met het ‘clipboard’ communiceren.

Wat gebeurt er nu als we Excel zouden vragen om de cellen 1-op-1 aan elkaar gelijk te zetten. Cel G1 is gelijk aan cel A1 en daarna cel G2 gelijk aan A2 en zo verder totdat alle 50 000 cellen op de correcte plaats staan. In dit voorbeeld hoef je niet met het externe ‘clipboard’ te communiceren en ga je direct met de bouwstenen van Excel aan de slag. De snelheidswinst is daarom ook gigantisch.

Opmerking: Een extra voordeel van deze werkwijze is dat enkel de inhoud van de cel wordt overgezet naar de andere cel. De opmaak wordt niet overgenomen.

Deze keer voegen we extra variabelen toe om per rij van links naar rechts te lussen (kolom 1 tot 5).

Sub Ex3_CopyTranspose()
Dim xRow As Long    ‘ 1 to 10000 (Top Bottom)
Dim xCol As Long    ‘ 1 to 5 (Left Right)
Dim dRow As Long    ‘ Destination Row
Debug.Print Now
dRow = 1
For xRow = 1 To 10000 Step 1
For xCol = 1 To 5
Cells(dRow, 7) = Cells(xRow, xCol)
dRow = dRow + 1
Next xCol
Next xRow
Debug.Print Now
‘Code Execution : 00:02 to 00:03 sec
End Sub

De uitvoertijd van deze code ligt ergens tussen de 2 en 3 seconden. Hier wordt geen snelheidswinst meer gehaald als je de ‘screenupdating’ nog zou toevoegen. Ik heb het voorbeeld getest met 20 000 rijen en daarbij was de uitvoertijd nog steeds identiek. Zelf zal ik deze lijnen toch steeds opnemen in de code omdat het op tragere computers misschien toch een verschil kan maken.

Sub Ex4_CopyTranspose()
Dim xRow As Long    ‘ 1 to 10000 (Top Bottom)
Dim xCol As Long    ‘ 1 to 5 (Left Right)
Dim dRow As Long    ‘ Destination Row
Debug.Print Now
Application.ScreenUpdating = False
dRow = 1
For xRow = 1 To 10000 Step 1
For xCol = 1 To 5
Cells(dRow, 7) = Cells(xRow, xCol)
dRow = dRow + 1
Next xCol
Next xRow
Application.ScreenUpdating = True
Debug.Print Now
‘Code Execution : 00:02 to 00:03 sec
End Sub

Volgende blogpost: Gegevens aan een tabel toevoegen (Blog 2/7)

Heb je na het lezen van deze blogpost de Excel- of zelfs de Power BI-microbe te pakken? Bekijk dan zeker ons aanbod open Excel-opleidingen en wie weet zien we je binnenkort in Antwerpen of Brussel.