如何将 VBA 集合写入 Excel 工作表

How to write a VBA collection to an Excel sheet

提问by psychonomics

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

定义类模块，命名为 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

子程序 1 - 填充集合

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

子程序 2 - 将集合写入工作表

采纳答案by psychonomics

I think the easiest way to print a Dictionaryonto Excel spreadsheet is by using WorksheetFunction.Transpose(VarianttypeArray)

我认为将字典打印到 Excel 电子表格的最简单方法是使用类型WorksheetFunction.Transpose(VariantArray)

The below code

下面的代码

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

• 创建一个带有键和项目的示例字典
• 创建两个数组（键、项）并一次性用字典中的元素填充它们
• 用于一次性WorksheetFunction.Transpose(VariantArray)打印数组

Option Explicit

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

'添加对 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 (notetableis a Collection)

如果这是你想要做的（注意是一个集合）table

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)

• 关掉 Application.ScreenUpdating
• 迭代集合并将值复制到数组中，然后使用 将WorksheetFunction.Transpose()所有内容一次性打印到工作表（使用答案第一部分的逻辑）

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)像这样重写（代码看起来有点难看，但效率应该还可以）

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

有关 VBA 集合迭代和打印到 Sheet @ vba4all.com 的更多详细信息

回答by Tamara

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".

首先确定工作簿中希望数组打印到的范围。在这个例子中，我假设我将输出范围命名为“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.)

第一次将 r.value 分配给 var_out（我打算填充的数组变量）根据范围的大小设置数组变量的维度。（它还读取范围内的任何现有值，因此如果您不想要那样，请清除我在此处显示的范围。）

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

数组变量对范围的第二次赋值会将值写回工作表。