Question

我正在解析XML文件并选择/为自定义类列表赋值。我现在正在做的是循环遍历列表以附加到Excel表（listobject）。这是一个简化的例子：

Private employee as New employee_Class

...

ProcessXML()

employee.GoToFirst    

Do  
  Set newRow = myTable.ListRows.Add
  Intersect(newRow.Range, myTable.ListColumns("FirstName").Range).value = employee.FirstName
  Intersect(newRow.Range, myTable.ListColumns("LastName").Range).value = employee.LastName

  '... (etc., etc.)

  employee.Next

Loop Until employee.EOF

我已经开始工作了。循环使用十几名员工是可行的，但当我有400或1000名员工时，需要几分钟。我想将附加到运行时（不可见）列表对象然后将运行时列表对象（作为一个整体）附加到我的表上会快得多，但我不知道该怎么做。 / p>

其次，我不确定使用Intersect是否是按列名附加值的最有效方式。

读取超过20,000个XML节点需要一瞬间，但写入它（大约400-500行）大约需要5-10分钟。我不太关心语法，因为我是关于技术的。有没有人有更快，更有效的技术将数百行附加到Excel表（ListObject）？提前谢谢。

Answer 1

1k recs

0.7秒

Sub Tester()

Dim d As Object
Dim tbl As ListObject, rw As ListRow
Dim cols, col, vals, x, t

    Set tbl = ActiveSheet.ListObjects(1)
    cols = Array("Col1", "Col2", "Col3", "Col4", "Col5", "Col6")

    'map column names to indexes...
    Set d = CreateObject("scripting.dictionary")
    For Each col In cols
        d.Add col, tbl.ListColumns(col).Index
    Next

    t = Timer
    Application.ScreenUpdating = False
    For x = 1 To 1000
        Set rw = tbl.ListRows.Add
        vals = rw.Range.Value
        vals(1, d("Col1")) = "test1"
        vals(1, d("Col2")) = "test2"
        vals(1, d("Col3")) = "test3"
        vals(1, d("Col4")) = "test4"
        vals(1, d("Col5")) = "test5"
        vals(1, d("Col6")) = "test6"
        rw.Range.Value = vals
    Next x
    Debug.Print Timer - t

End Sub

单独禁用ScreenUpdating会产生很大的影响。

Answer 2

最快的方法可能是填充数组中的数据，然后将数组分配给范围值，然后调整表的大小。像（重用蒂姆威廉姆斯代码）（0.6代表10000）：

Option Explicit

Sub Tester()


    Dim employeeTable As ListObject

    Set employeeTable = ActiveSheet.ListObjects(1)

    Dim columnArray As Variant
    columnArray = Array("Col1", "Col2", "Col3", "Col4", "Col5", "Col6")

    Dim dict As Object
    'map column names to indexes...
    Set dict = CreateObject("scripting.dictionary")

    Dim currentColumn As Variant
    For Each currentColumn In columnArray
        dict.Add currentColumn, employeeTable.ListColumns(currentColumn).Index
    Next

    Dim t
    t = Timer
    Application.ScreenUpdating = False

    Dim numberOfEmployees As Long
    numberOfEmployees = 10000

    Dim employeeArray As Variant
    ReDim employeeArray(1 To numberOfEmployees, 1 To employeeTable.ListColumns.Count)


    Dim i As Long
    For i = 1 To numberOfEmployees
        employeeArray(i, dict("Col1")) = "test1"
        employeeArray(i, dict("Col2")) = "test2"
        employeeArray(i, dict("Col3")) = "test3"
        employeeArray(i, dict("Col4")) = "test4"
        employeeArray(i, dict("Col5")) = "test5"
        employeeArray(i, dict("Col6")) = "test6"
    Next

    Dim numberOfTableRows As Long
    numberOfTableRows = employeeTable.ListRows.Count
    employeeTable.HeaderRowRange.Offset(numberOfTableRows + 1).Resize(numberOfEmployees).Value = employeeArray
    employeeTable.Resize employeeTable.HeaderRowRange.Resize(numberOfTableRows + numberOfEmployees + 1)

    Debug.Print Timer - t

End Sub

使用VBA将多行附加到Excel表的最有效方法是什么？

2 个答案: