VBA - 修剪功能:减少操作/冻结时间

Question

我在 VBA 中编写了代码，删除了字符之间的一些潜在空格。代码运行良好，但当文件包含数千行时会变得非常慢。我想知道是否有可能改进它，以减少操作时间，但也主要是阻止文件冻结。这是代码：

Sub Test()
Dim cell as Range
Dim sht As Worksheet
Dim LastRow As Long
Dim StartCell As Range
Dim areaToTrim As Range
Set sht = ThisWorkbook.Worksheets("SS upload")
Set StartCell = sht.Range("A14")
LastRow = sht.Cells(sht.Rows.Count, StartCell.Column).End(xlUp).Row
Set areaToTrim = sht.Range("B14:B" & LastRow)
For Each cell In areaToTrim
cell.Value = Trim(cell.Value)
Next cell
End Sub

Answer 1

最快的方法是将范围读入数组，在那里修剪它，然后将其写回范围：

Sub Test()
Dim sht As Worksheet
Dim LastRow As Long
Dim StartCell As Range
Dim areaToTrim As Range
Dim varArray() As Variant
Dim i As Long
Set sht = ThisWorkbook.Worksheets("SS upload")
Set StartCell = sht.Range("A14")
LastRow = sht.Cells(sht.Rows.Count, StartCell.Column).End(xlUp).Row
Set areaToTrim = sht.Range("B14:B" & LastRow)
varArray = areaToTrim ' Read range into array
For i = LBound(varArray, 1) To UBound(varArray, 1)
varArray(i, 1) = Trim(varArray(i, 1))
Next i
areaToTrim.Value = varArray ' Write array back to range
End Sub

无需担心Application.ScreenUpdating或Application.Calculation.又好又简单！

如果您仍然担心任何响应能力，请在循环正文中放一个DoEvents。

Answer 2

您可以在循环中插入DoEvents时防止冻结。 然后执行它，每百分之一说一次。 这将使循环运行速度稍慢，但允许用户同时使用 GUI。

...
Dim cnt As Integer
For Each cell In areaToTrim
cell.Value = Trim(cell.Value)
cnt=cnt + 1
If cnt Mod 100 = 0 Then
DoEvents
End If
Next cell
...

您可以调整数字以根据您的需求对其进行优化。

DoEvents也带来了一些问题。可以在此处找到有关DoEvents的良好解释。

Answer 3

尝试这样做，以减少屏幕更新。这是一段代码，我一直使用，因此对于当前问题来说，某些命令可能有点太多了，但它们仍然有用。

作为第二点 - 不要声明名为Cell的变量，稍后您可能会因此而受苦。rngCell或myCell或其他任何内容声明它，这不是 VBE 变量的一部分。

Public Sub TestMe()
Call OnStart
'YourCode
Call OnEnd
End Sub    
Public Sub OnEnd()
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.AskToUpdateLinks = True
Application.DisplayAlerts = True
Application.Calculation = xlAutomatic
ThisWorkbook.Date1904 = False
Application.StatusBar = False
End Sub
Public Sub OnStart()
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.AskToUpdateLinks = False
Application.DisplayAlerts = False
Application.Calculation = xlAutomatic
ThisWorkbook.Date1904 = False
ActiveWindow.View = xlNormalView
End Sub

如果您愿意，可以将范围保存为数组并在那里进行修剪操作。但是，如果您不习惯使用数组，则可能会使您的代码过于复杂 - 在Excel中使用VBA修剪单元格