9

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

该代码通过依次遍历每个项目将二维集合写入新工作表。我以前从未使用过集合，并且想一次性将集合写入工作表。当表有很多记录时，当前代码需要很长时间。

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

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

定义类模块，命名为 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 - 将集合写入工作表

4

2 回答 2

10

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

下面的代码

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

Option Explicit

'添加对 Microsoft 脚本运行时的引用' >> 工具 >> 参考 >> Microsoft 脚本运行时

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的更多详细信息

于 2013-08-14T11:04:40.643 回答
4

如果我想将已在代码中填充的二维数组写入工作表，则使用此代码。它非常有效，因为它只与工作表“对话”一次

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（我打算填充的数组变量）根据范围的大小设置数组变量的维度。（它还会读取范围内的任何现有值，因此如果您不希望这样做，请清除我在此处显示的范围。）

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

于 2013-12-19T04:06:10.933 回答