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

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)

Sub Routine 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)

以下代码

• 使用键和项创建示例字典
• 创建两个Arrays (键,项)并使用 Dictionary 中的元素一次填充它们
• 使用WorksheetFunction.Transpose(VariantArray)打印阵列一气呵成

Option Explicit

'添加对Microsoft Scripting Runtime的引用'>>工具>>参考资料>> 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集合迭代和打印到Sheet @ vba4all.com的更多详细信息