更新

Question

我有一些我正在修改的现有代码。此代码从预先存在的工作表表创建行集合。它创建了一个大型的2-D集合，每列中都有不同的信息。有一个单独的类模块，用于声明每列的数据类型。

代码依次循环遍历每个项目，将2-D集合写入新工作表。我之前从未使用过集合，并希望一次性将集合写入工作表。当表有大量记录时，当前代码需要很长时间。

有没有办法将整个集合转换为二维数组，或者我可以一次编写二维数组？或者有没有办法将整个集合写入工作表，就像使用二维数组一样？我试图搜索这个并且到目前为止都没有成功。任何一般点都将不胜感激！

以下是一些示例代码，其中的注释以粗体显示，以说明如何使用该集合。

定义类模块，命名为TableEntry

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

主要例程 - 创建集合，填写集合，将集合写入表格

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)

子例程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

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

Answer 1

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

以下代码

使用键和项
创建示例词典
创建两个阵列（键，项目）并使用元素填充它们来自词典一次性

使用WorksheetFunction.Transpose(VariantArray)打印数组 一个人去

Option Explicit

'添加对Microsoft Scripting Runtime的引用 '＆gt;＆gt;工具＆gt;＆gt;参考＆gt;＆gt; 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

<小时/>

更新

在您的情况下......

如果您正在尝试这样做（注意 table 是一个集合 ）

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

不幸的是，答案是否定的。

如果不迭代整个集合，则无法将集合转置到电子表格中。

您可以采取哪些措施加快进程：

关闭Application.ScreenUpdating

遍历集合并将值复制到数组中，然后使用WorksheetFunction.Transpose()进行打印所有内容一次性（使用第一个中的逻辑部分答案）

跟进：

在你的情况下，你可以像这样重写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

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

Answer 2

如果我想将我在代码中填充的2D数组写入工作表，我会使用此代码。这是非常有效的，因为它只与工作表“谈”一次

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

首先确定要将阵列打印到的工作簿中的范围。在这个例子中，我假设我将输出范围命名为“OutputValues”。

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

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

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

2 个答案:

更新