Jak napisać kolekcję VBA do arkusza Excel [duplikat]

To pytanie ma już tutaj odpowiedź:

Skopiuj wartości kolekcji do tablicy 2D w VBA 1 odpowiedź

Mam istniejący kod, który modyfikuję. Ten kod tworzy kolekcję wierszy z wcześniej istniejących tabel arkuszy. Tworzy dużą kolekcję dwuwymiarową z odrębnymi informacjami w każdej kolumnie. Istnieje oddzielny moduł klasy, który deklaruje typ danych dla każdej kolumny.

Kod zapisuje kolekcję 2-D do nowego arkusza, przechodząc kolejno przez każdy element. Nigdy wcześniej nie korzystałem z kolekcji i chciałbym zapisać kolekcję na arkuszu w jednym przebiegu. Obecny kod trwa dość długo, gdy tabela zawiera wiele rekordów.

Czy istnieje sposób na przekonwertowanie całej kolekcji na tablicę 2-D lub po to, aby następnie zapisać tablicę 2-D za jednym razem? A może istnieje sposób na zapisanie całej kolekcji do arkusza, tak jak w przypadku tablicy 2-D? Próbowałem tego szukać i jak dotąd nie udało się. Wszelkie ogólne uwagi zostaną docenione!

Oto przykładowy kod z pogrubionymi komentarzami ilustrujący sposób, w jaki kolekcja jest używana.

Zdefiniuj moduł klasy o nazwie TableEntry

Public Item1 As String
Public Item2 As String
Public Item3 As String
Public Item4 As Integer
Public Item5 As Integer

Główna procedura - Utwórz kolekcję, Wypełnij kolekcję, Napisz kolekcję do arkusza

Sub MainRoutine()

Dim table As Collection
Set table = New Collection

Call FillCollection(File As String, ByRef table As Collection)

Call WriteCollectionToSheet(ByRef table As Collection)

Procedura podrzędna 1 - Wypełnij kolekcję

Dim wb As Workbook
Set wb = Workbooks.Open(File)

Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets

Dim R As Range
Set R = ws.Range("A2")

  Dim e As TableEntry
  For i = 1 To 20

    Set e = New TableEntry

    e.Item1 = R.Offset(i + 1, 0).Offset(0, 0)
    e.Item2 = R.Offset(i + 1, 0).Offset(0, 1)
    e.Item3 = R.Offset(i + 1, 0).Offset(0, 2)
    e.Item4 = R.Offset(i + 1, 0).Offset(0, 3)
    e.Item5 = R.Offset(i + 1, 0).Offset(0, 4)

    table.Add e

  Next i

Next ws

Sub Routine 2 - Napisz kolekcję do arkusza

questionAnswers(2)

yourAnswerToTheQuestion