我正在尝试将存储在文本中的数字转换为多个工作表上的数字。我的问题是我拼凑的代码似乎花费了过多的时间。我正在使用 For Each 语句循环遍历必要的工作表和范围。它不会使 Excel 崩溃,它只是看起来永远运行。
Sub ConvertTextToNumber()
Application.ScreenUpdating = False
Dim WshtNames As Variant
Dim WshtNameCrnt As Variant
Dim r As Range
WshtNames = Array("Financial Data", "Site Data ", "Org Data", "Program Data")
For Each WshtNameCrnt In WshtNames
On Error Resume Next
For Each r In Worksheets(WshtNameCrnt).UsedRange.SpecialCells(xlCellTypeConstants)
If IsNumeric(r) Then r.Value = Val(r.Value)
Next
Next
Application.ScreenUpdating = False
End Sub
当我停止运行脚本并单击 Debug 时,它似乎被第一个 Next 语句赶上了。我认为我用来转换值的方法比必要的时间密集得多,因此在多张纸上运行它甚至更糟。
我乐于接受任何和所有建议,以使此过程运行得更快。提前致谢!
试试下面的代码。我使用了索引号,而不是尝试使用变体遍历数组。我可能是错的,但我认为 For Each 仅适用于集合。如果我错了,请有人纠正我。(编辑:我确实弄错了。For Each 在这里工作得很好。)
无论如何,数组上的索引号是最佳实践。
我还删除了您的 Resume Next 并妥善处理了它。我强烈建议不要使用 Resume Next。我想不出有什么事件是 Resume Next 不能被良好的逻辑所取代。
Sub ConvertTextToNumber()
Application.ScreenUpdating = False
' These two statements should further improve processing time.
' The first prevents formulas from calculating. The second prevents
' any background events from firing (mostly for Event triggered macros).
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
Dim WshtNames As Variant
Dim i as Long
Dim r As Range
WshtNames = Array("Financial Data", "Site Data ", "Org Data", "Program Data")
' When looping over an array use an index number.
' I this case, 'i' will go from the lowest range of the array
' all the way through to the highest range of the array.
For i = LBound(WshtNames) to Ubound(WshtNames)
'On Error Resume Next ' It is best to catch the errors, dont just skip them.
If Not Worksheets(WshtNames(i)) Is Nothing Then
For Each r In Worksheets(WshtNames(i)).UsedRange.SpecialCells(xlCellTypeConstants)
' No need to check for an empty string here since
' IsNumeric() will return false for non-numbers.
If IsNumeric(r) Then r.Value = Val(r.Value)
Next
Else
' Put your error handling in here, or you can just skip it
' I tend to use debug.print just to keep track.
Debug.Print WshtNames(i) & " doesn't exist."
End If
Next
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
End Sub
本文收集自互联网,转载请注明来源。
如有侵权,请联系[email protected] 删除。
我来说两句