我目前有几十列,每行有数百行。我调用的其中一个子进程在从Web托管的XML进入后修改了单元格的数据。当前的方法有效,但由于它逐个单元地进行更改,因此往往会有点慢。这是我的代码:
Private Sub fixEnt(listCol As ListColumn) 'fixes the HTML/XML entities
Dim rng As Range
On Error Resume Next
Set rng = listCol.DataBodyRange.SpecialCells(xlCellTypeConstants)
On Error GoTo 0
If Not rng Is Nothing Then
For Each areaItem In rng.Areas 'iterate over the arrays in the Areas array
For Each cell In areaItem 'iterate over the values in the Item array
cell.Value = decodeEnt(cell.Value)
Next
Next
End If
End Sub
调用decodeEnt:
Private Function decodeEnt(cellVal As String) As String
Dim tempStr$ 'holds new value after replace
tempStr = Replace(cellVal, """, Chr(34)) 'Chr(34) is a "
tempStr = Replace(tempStr, "'", "'")
tempStr = Replace(tempStr, "&", "&")
tempStr = Replace(tempStr, "<", "<")
tempStr = Replace(tempStr, ">", ">")
tempStr = Replace(tempStr, " ", " ")
tempStr = Replace(tempStr, "#", "#")
tempStr = Replace(tempStr, " ", " ")
tempStr = Replace(tempStr, "<", "<")
tempStr = Replace(tempStr, ">", ">")
tempStr = Replace(tempStr, """, Chr(34))
tempStr = Replace(tempStr, "'", "'")
tempStr = Replace(tempStr, "&", "&")
tempStr = Replace(tempStr, "–", "–")
tempStr = Replace(tempStr, "ü", "ü")
tempStr = Replace(tempStr, "°", "°")
tempStr = Replace(tempStr, "ä", "ä")
tempStr = Replace(tempStr, "ü", "ü")
tempStr = Replace(tempStr, "’", "’")
decodeEnt = tempStr 'Return modified string
End Function
有更快的方法来执行该操作吗?也许在rng.Areas数组中同时修改数据的东西?速度是这个项目的关键,但在这种情况下我没有想法。
由于
编辑:进一步澄清该项目。它从另一个工具的API导入XML文件,并将其保存到Excel中的表中。我有其他代码刷新连接,附加XML(新旧)的所有数据。刷新过程完成后,它开始进行数据修改,包括修复单元格中的HTML / XML实体并修复日期格式。完成修改后,它会删除重复的行(因为在刷新时无法仅添加新数据)。
希望这可以解决任何困惑。
答案 0 :(得分:1)
范围的替换功能可能更快。
获取一般性能提示(特别是ScreenUpdating,计算和“在单次操作中读/写大块单元”):
http://blogs.office.com/2009/03/12/excel-vba-performance-coding-best-practices/
(根据我的经验,主要的帮助是停用Application.ScreenUpdating,在单个操作中停用Application.Calculation或读/写大块单元格)
答案 1 :(得分:1)
我怀疑以下情况会更快(一次完成所有细胞):
Sub test()
Dim replaceThis()
Dim withThis()
replaceThis = Array("<", ">") ' etc
withThis = Array("<", ">") ' etc
Application.ScreenUpdating = False
For i = LBound(replaceThis) To UBound(replaceThis)
'MsgBox "replacing " & replaceThis(i) & " with " & withThis(i)
Range("A1:A5").Replace What:=replaceThis(i), Replacement:=withThis(i), _
LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False
Next i
Application.ScreenUpdating = True
End Sub
注意 - 您需要创建一个包含所有替换的数组,并且我对该范围进行了硬编码:您需要创建该变量。但是看到你的代码,我想你可以从这里弄明白。