我绝望地试图找到一种更好的方法来填充范围内容。这种方式会产生正确的结果,但速度很慢。谁能指出我在如何填充二维数组或以其他方式加速算法方面的正确方向?我会喜欢有人成功使用的代码片段,甚至只是显示更清洁方法的链接。
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
最佳答案
为了有效地做到这一点,您应该使用要写入的数据生成二维数据,然后一次性将其全部写入。
类似于以下内容。为了与其他语言兼容,我更喜欢基于 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
关于excel vba - 有效循环二维数组,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/7626163/