Excel Forum - Porady, Pomoc, Excel Help, Excel FAQ - Tablice dwuwymiarowe w VBA - wypełnianie wierszami/kolumnami

Maciej Gonet

Zazwyczaj przyjmuje się, że tablice dwuwymiarowe w VBA należy wypełniać indywidualnie iterując po każdym elemencie. Od tej ogólnej zasady istnieją jednak wyjątki pozwalające wypełniać tablice całymi wierszami lub kolumnami. Pozwala to czasem skrócić czas obliczeń. Przeglądałem ostatnio pod tym kątem zasoby internetu i stwierdziłem, że temat ten nie jest często poruszany, może więc warto przyjrzeć mu się trochę bliżej.
W załączonym tekście i pliku omawiam typowe przypadki pracy z tablicami. Możliwość zapisu całych wierszy lub kolumn jest konsekwencją zastosowania nietypowej struktury tablicy.

Tablice dwuwymiarowe w VBA.docx

Pobierz Plik ściągnięto 38 raz(y) 16.72 KB

Tablice2W_wierszami_kolumnami.xlsm

Pobierz Plik ściągnięto 36 raz(y) 23.14 KB

Marecki · Wysłany: 18-02-2021, 10:41

To ja dorzucę do przykładu Macieja, rozwiązanie API funkcją CopyMemory.
Rozwiązanie w Arkuszu2.

Tablice2W_wierszami_kolumnami.xlsm

Pobierz Plik ściągnięto 9 raz(y) 32.3 KB

Maciej Gonet · Wysłany: 18-02-2021, 11:28

Ładnie

, może się przydać, ale przydałyby się komentarze dla osób mniej biegłych w API, co jest istotne, a co nie.
Na przykład, czy tablice muszą być deklarowane z nawiasami

Kod:

Dim Tbl1() As Variant

czy wystarczy?

Kod:

Dim Tbl1

Po co na końcu każdej procedury kasujesz Erase tablice zadeklarowane lokalnie? Logicznie rzecz biorąc one się powinny same skasować po zakończeniu procedury.

Marecki · Wysłany: 18-02-2021, 12:10

Rafał B. · Wysłany: 18-02-2021, 12:38

Robiłeś może testy wydajności na większych danych czy faktycznie gra jest warta świeczki, żeby wykorzystywać zabawy z pamięcią? Gdzieś na liście projektów "for fun" mam zamknięcie pomysłu Macieja w zgrabnej, wygodnej do użytku klasie. Dlatego pytam, bo jak różnica wydajności będzie mała, to nie angażowałbym API ze względu braku kompatybilności z Mac. A jak znaczna, to w sumie można dodać kolejny #IF w kompilacji warunkowej. :-)

Marecki · Wysłany: 18-02-2021, 16:08

Moim zdaniem warto.
Programowanie niskopoziomowe zawsze będzie szybsze od wysokopoziomowego.
Z ciekawości zrobię testy na dużych tablicach i dam znać.

Edit:

Zrobiłem, ale na "małej" tablicy (1 to 65536, 1 to 15)
65536 to maksymalna wartość, z która poradzi sobie funkcja Transpose.
Nie chciałem już kombinować z pętlami by ominąć ową funkcję, więc zostałem przy tym wymiarze.
Czas dla API dwukrotnie krótszy.
Do testów :

Kod:

Option Explicit

#If VBA7 And Win64 Then
Public Declare PtrSafe Sub ZeroMemory Lib "kernel32" Alias "RtlZeroMemory" (ByVal Destination As Any, ByVal iLen As LongPtr)
Public Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByVal Destination As Any, ByVal Source As Any, ByVal Length As LongPtr)
Public Const iSize As LongPtr = 24
#Else
Public Declare Sub ZeroMemory Lib "kernel32" Alias "RtlZeroMemory" (ByVal Destination As Any, ByVal iLen As Long)
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByVal Destination As Any, ByVal Source As Any, ByVal Length As Long)
Public Const iSize As Long = 16
#End If

Sub Start()
Dim i As Long
Dim j As Long
Dim Start As Single
Dim Tbl1(1 To 65536, 1 To 15)
Dim Tbl2(1 To 65536, 1 To 1)

For i = 1 To UBound(Tbl1, 1)
For j = 1 To UBound(Tbl1, 2)
Tbl1(i, j) = Int((999 * Rnd) + 1)
Next j
Next i
Range("A1").Resize(i - 1, j - 1).Value = Tbl1

For i = 1 To UBound(Tbl2, 1)
Tbl2(i, 1) = i
Next i

Range("Q1").Resize(i - 1).Value = Tbl2

Range("S1:S65536").Value = Range("O1:O65536").Value

Start = Timer
Call Zamien_kolumne_v1
Debug.Print "Makro ""Zamien_kolumne_v1"" wykonywało się : " & Format(Timer - Start, "0.00") & " sec."

Start = Timer
Call Zamien_kolumne_v2
Debug.Print "Makro ""Zamien_kolumne_v2"" wykonywało się : " & Format(Timer - Start, "0.00") & " sec."

End Sub

Sub Zamien_kolumne_v1()
Dim Tbl1
Dim x, i As Long

ReDim x(1 To 15)

Tbl1 = Range("A1:O65536").Value

With Application
For i = 1 To 14
x(i) = .Transpose(.Index(Tbl1, 0, i))
Next i

x(15) = .Transpose(Range("Q1:Q65536").Value)

Range("S1").Resize(65536, 15) = .Transpose(x)
End With

End Sub

Sub Zamien_kolumne_v2()
Dim Tbl1() As Variant
Dim Tbl2() As Variant

Tbl1 = Range("A1:O65536").Value
Tbl2 = Range("Q1:Q65536").Value

CopyMemory VarPtr(Tbl1(1, 15)), VarPtr(Tbl2(1, 1)), iSize * UBound(Tbl2)
Range("AJ1").Resize(65536, 15).Value = Tbl1

ZeroMemory VarPtr(Tbl1(1, 1)), UBound(Tbl1, 1) * UBound(Tbl1, 2) * iSize
Erase Tbl1, Tbl2
End Sub

Zamieniamy tutaj ostatnią kolumnę tablicy.