excel vba - 高效循环2d数组

Question

我无可救药地试图找到一种更好的填充范围内容的方法.这种方式产生了正确的结果,但速度很慢.任何人都可以指出我在如何填充二维数组或加速算法方面的正确方向？我希望有人能够取得成功的代码片段,甚至只是显示更清晰方法的链接.

here is my OLD code:
----------------
    f = 1
    maxcol = 'func call to get last non blank col ref .ie could return T, R, H.etc

    For f = 1 To UBound(filenames)
        Set aDoc = LoadXmlDoc(filenames(f))
        For Each c In Worksheets("Results").Range("A1:" & maxcol & "1")
                                        c.Offset(f, 0).Value = aNode.Text
                    Next c
        Worksheets("Results").Range(maxcol & "1").Offset(f, 0).Value = filenames(f)
    Next f


UPDATED CODE:
----------

Dim aDoc As DOMDocument
Dim aNode As IXMLDOMNode
Dim numOfXpaths As Integer
Dim filenames As Variant
Dim f As Integer
Dim maxcol As String
Dim rngStart As Range
Dim nColIndex As Long
Dim lngCalc As Long
'Dim numOfFiles As Integer
Dim aXpaths As Variant
        numOfFiles = UBound(filenames)
    colToRow aXpaths, numOfXpaths
    maxcol = Number2Char(numOfXpaths)
        ReDim aValues(1 To numOfFiles, 1 To numOfXpaths + 1) As Variant
        For f = 1 To numOfFiles
            Set aDoc = LoadXmlDoc(filenames(f))
            For nColIndex = 1 To numOfXpaths
                    If aDoc.parseError Then
                        aValues(f, nColIndex) = "XML parse error:" 
                    Else
                      Set aNode = aDoc.selectSingleNode(aXpaths(nColIndex))
                      aValues(f, nColIndex) = aNode.Text
                    End If
            Next nColIndex
            aValues(f, numOfXpaths + 1) = filenames(f)
        Next f
        Worksheets("Results").Range("A1").Offset(1, 0).Resize(numOfFiles, numOfXpaths + 1).Value = aValues


    Function colToRow(ByRef aXpaths As Variant, ByRef numOfXpaths As Integer)
    Dim xpathcount As Integer
    Dim c As Integer
    'Dim aXpaths As Variant
    xpathcount = Worksheets("Xpaths").Cells(Rows.Count, "A").End(xlUp).Row - 1
    ReDim aXpaths(1 To xpathcount + 1) As Variant
    For c = 0 To xpathcount
        Worksheets("Results").Range("A1").Offset(0, c) = Worksheets("Xpaths").Range("A1").Offset(c, 0)
        Worksheets("Results").Range("A1").Offset(0, c).Columns.AutoFit
        aXpaths(c + 1) = Worksheets("Xpaths").Range("A1").Offset(c, 0)
    Next c
    Worksheets("Results").Range("A1").Offset(0, xpathcount + 1) = "Filename"
    'colToRow = xpathcount + 1
    numOfXpaths = xpathcount + 1
    End Function

Function Number2Char(ByVal c) As String
Number2Char = Split(Cells(1, c).Address, "$")(1)
End Function

Answer 1

要有效地执行此操作,您应该使用要编写的数据生成二维数据,然后一次性写入.

像下面这样的东西.我更喜欢基于0的数组与其他语言的兼容性,而你似乎使用的是基于1的数组(1 to UBound(filenames).因此,在以下未经测试的代码中可能存在逐个错误:

f = 1
maxcol = 'func call to get last non blank col ref .ie could return T, R, H.etc

' 2D array to hold results    
' 0-based indexing: UBound(filenames) rows and maxcol columns
Dim aValues(0 to UBound(filenames)-1, 0 To maxcol-1) As Variant
Dim rngStart As Range
Dim nColIndex As Long

For f = 1 To UBound(filenames)
    Set aDoc = LoadXmlDoc(filenames(f))

    aValues(f-1, 0) = filenames(f)

    For nColIndex = 1 To maxCol-1
        aValues(f-1, nColIndex) = aNode.Text
    Next nColIndex

Next f

' Copy the 2D array in one go
Worksheets("Results").Offset(1,0).Resize(UBound(filenames),maxCol).Value = aValues