Excel到XML：性能提高

我想问一个问题，如果他有什么想法如何使这个代码更快。 目前在大数据（超过180 000行/ 39列）的情况下，大约需要5个半小时才能生成所有代码，以防万一使用MS Excel 2007。

我会很乐意提供任何build议。

Sub TOXML() strChoosenFile = InputBox("Write number of file which you want generate.", "Choose sheet for generation XML") Worksheets("time").Cells(1, 1) = Now Application.ScreenUpdating = False Dim lngRow As Long Dim strInsetText$ lngRow = 1 RowsInSource = Worksheets(strChoosenFile).Range("A300000").End(xlUp).Row - 2 ColumnsInSource = Worksheets(strChoosenFile).Range("DD2").End(xlToLeft).Column For i = 1 To RowsInSource strInsetText = "<R>" For x = 1 To ColumnsInSource strInsetText = strInsetText & "<S>" & Worksheets(strChoosenFile).Cells(i + 2, x).Text & "</S>" Next x strInsetText = strInsetText & "</R>" Worksheets(strChoosenFile & "-XML").Cells(lngRow, 1) = strInsetText lngRow = lngRow + 1 strInsetText = "" Next i Worksheets("time").Cells(1, 2) = Now Application.ScreenUpdating = True MsgBox "Done: " & i - 1 End Sub 

Answer 1

试试这个代码。 我的机器只需要15秒 （180 000行/ 39列）

 Sub TOXML() Dim strChoosenFile Dim lngRow As Long, RowsInSource As Long, ColumnsInSource As Long, i As Long, x As Long Dim strInsetText As String Dim arr Dim res() As String strChoosenFile = InputBox("Write number of file which you want generate.", "Choose sheet for generation XML") Worksheets("time").Cells(1, 1) = Now Application.ScreenUpdating = False With Worksheets(strChoosenFile) RowsInSource = .Range("A300000").End(xlUp).Row - 2 ColumnsInSource = .Range("DD2").End(xlToLeft).Column 'write all values in array arr = .Range(.Cells(3, 1), .Cells(RowsInSource + 2, ColumnsInSource)).Value End With 'Redim array for result, note that I'm using 2D array, 'because I want to get "Column" array, rather than "Row" array ReDim res(1 To RowsInSource, 1 To 1) For i = 1 To RowsInSource res(i, 1) = "<R>" For x = 1 To ColumnsInSource res(i, 1) = res(i, 1) & "<S>" & arr(i, x) & "</S>" Next x res(i, 1) = res(i, 1) & "</R>" Next i 'write result of array on the sheet Worksheets(strChoosenFile & "-XML").Cells(1, 1).Resize(UBound(res)).Value = res Worksheets("time").Cells(1, 2) = Now Application.ScreenUpdating = True MsgBox "Done: " & i - 1 End Sub 

此外，我不知道为什么你硬编码.Range("A300000")和.Range("DD2") （也许你需要它），但也阅读： 如何确定最后使用的行/列

Answer 2

build议：尝试将工作表数据移动到数组中：

 dim ar() as variant ar = Worksheets(strChoosenFile).Range("A1").CurrentRegion 'or any range selection method 

然后使用数组元素而不是单元格。 这将最大限度地减lessVBA和工作表之间的交换，这些工作表是昂贵的（就性能而言）。
同样，你也可以加载整个行而不是单元格。