How to write a VBA collection to an Excel sheet [duplicate]

问题

This question already has an answer here:

Copy the values of a collection to a 2D array in VBA (1 answer)

Closed 4 years ago.

I have some existing code that I am modifying. This code creates a collection of rows from preexisting worksheet tables. It creates a large 2-D collection, with distinct information in each column. There is a separate class module that declares the data type for each column.

The code writes the 2-D collection to a new sheet by looping through each item in turn. I have never used a collection before, and would like to write the collection to the sheet in a single pass. The current code takes quite a long time when the table has lots of records.

Is there a way to convert the entire collection to a 2-D array, or so that I can then write the 2-D array in a single go? Or is there a way to write the entire collection to the sheet, just like with a 2-D array? I have tried to search for this and have so far been unsuccessful. Any general points would be appreciated!

Here is some example code, with comments in bold, to illustrate how the collection is being used.

Define the Class Module, Named as TableEntry

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

Main Routine - Create the Collection, Fill the Collection, Write Collection to Sheet

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)

Sub Routine 1 - Fill the Collection

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 - Write Collection to Sheet

回答1:

I think the easiest way to print a Dictionary onto Excel spreadsheet is by using WorksheetFunction.Transpose(Variant type Array)

The below code

• Creates a sample Dictionary with keys and items
• Creates two Arrays (keys, items) and fills them with the elements from the Dictionary in one go
• Uses WorksheetFunction.Transpose(VariantArray) to print arrays in one go

Option Explicit

' Add Reference to Microsoft Scripting Runtime ' >> Tools >> References >> Microsoft Scripting Runtime

Sub CollectionToArrayToSpreadSheet()
    Cells.ClearContents
    ' think of this collection as
    '   key     =   cell.row
    '   item    =   cell.value
    Dim dict As New Dictionary
    dict.Add Key:=1, Item:="value1"
    dict.Add Key:=2, Item:="value2"
    dict.Add Key:=3, Item:="value3"

    ' THIS WAY
    'Range("A1:A" & UBound(dict.Keys) + 1) = WorksheetFunction.Transpose(dict.Keys)
    'Range("B1:B" & UBound(dict.Items) + 1) = WorksheetFunction.Transpose(dict.Items)

    ' OR
    Range("A1").Resize(UBound(dict.Keys) + 1, 1) = WorksheetFunction.Transpose(dict.Keys)
    Range("B1").Resize(UBound(dict.Items) + 1, 1) = WorksheetFunction.Transpose(dict.Items)

End Sub

---

Update:

In your case...

If this is what you are trying to do (note table is a Collection)

Range("A1:A" & table.Count) = WorksheetFunction.Transpose(table)

Unfortunately, the answer is NO.

You can't transpose a collection over to a spreadsheet without iterating through the collection.

What you can do to speed the process up is:

• turn off Application.ScreenUpdating
• iterate over the collection and copy the values over to an array, then use the WorksheetFunction.Transpose() to print everything to sheet in one go (use the logic from the first part of the answer)

Follow up:

In your case you can rewrite the Sub WriteCollectionToSheet(ByRef table As Collection) like this (the code looks a bit ugly but the efficiency should be OK)

Sub WriteCollectionToSheet(ByRef table As Collection)

    Dim dict1 As New Dictionary
    Dim dict2 As New Dictionary
    Dim dict3 As New Dictionary
    Dim dict4 As New Dictionary
    Dim dict5 As New Dictionary

    Dim i As Long
    For i = 1 To table.Count
        dict1.Add i, table.Item(i).Item1
        dict2.Add i, table.Item(i).Item2
        dict3.Add i, table.Item(i).Item3
        dict4.Add i, table.Item(i).Item4
        dict5.Add i, table.Item(i).Item5
    Next i

    Range("A1:A" & UBound(dict1.Items) + 1) = WorksheetFunction.Transpose(dict1.Items)
    Range("B1:B" & UBound(dict2.Items) + 1) = WorksheetFunction.Transpose(dict2.Items)
    Range("C1:C" & UBound(dict3.Items) + 1) = WorksheetFunction.Transpose(dict3.Items)
    Range("D1:D" & UBound(dict4.Items) + 1) = WorksheetFunction.Transpose(dict4.Items)
    Range("E1:E" & UBound(dict5.Items) + 1) = WorksheetFunction.Transpose(dict5.Items)

End Sub

More details on VBA Collections iterations and printing to Sheet @ vba4all.com

回答2:

If I want to write a 2D array that I've populated inside the code to a worksheet, I use this code. It is very efficient, as it only 'talks' to the worksheet once

Dim r as Range
Dim var_out as Variant
Set r = Range("OutputValues")  
r.clear
var_out = r.value

'Then use code to appropriately fill the new 2D array var_out, such as your subroutine 1 above

r.value = var_out

You start by identifying the range in the workbook you want the array to print to. In this example, I assumed I named the output range "OutputValues".

The first assignment of r.value to var_out (my array variable I intend to populate) sets the dimensions of the array variable based on the size of the range. (It also reads in any existing values in the range, so if you don't want that, clear the range as I've shown here.)

The second assignment of the array variable to the range writes the values back to the sheet.

来源：https://stackoverflow.com/questions/18227942/how-to-write-a-vba-collection-to-an-excel-sheet