加快Cell替换VBA

Question

我有一个小代码，在一个列中格式化电话号码，在某种意义上:-如果它之间有空格，它会删除它们-之后，从右边开始取9个数字，并检查它是否是整数，如果是，则将其放入单元格。

问题是，它需要近6-7秒来完成所有的替换(3000个单元格，其中大部分是空白的)。有什么加快速度的办法吗?

多谢

targetSheet.Columns("M:M").Cells.Replace what:=fnd, Replacement:=rplc, _
LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _
SearchFormat:=False, ReplaceFormat:=False

For i = 2 To targetSheet.Range("M" & Rows.Count).End(xlUp).Row
If Len(targetSheet.Cells(i, 13).Value) > 9 Then
Phone = Right(targetSheet.Cells(i, 13).Value, 9)
If IsNumeric(Phone) = True Then
targetSheet.Cells(i, 13).Value = Phone
Else
targetSheet.Cells(i, 13).Value = ""
End If
End If
Next i```

Answer 1

使用数组替换单元格

• 您可以"应用"空格的删除到范围。对于剩余的作业，将范围值写入数组，修改它们并将其写回范围。

编辑:

• 请注意，我已经添加了三个缺失的Replace参数，因为False不是它们的默认值:MatchCase是肯定的，最后两个不清楚。SearchOrder和MatchByte在这种情况下不重要。点击这里了解更多。

代码

Option Explicit
Sub test()
Dim trg As Range
With targetSheet.Range("M2")
Set trg = .Resize(.Worksheet.Rows.Count - .Row + 1) _
.Find("*", , xlFormulas, , , xlPrevious)
If trg Is Nothing Then Exit Sub
Set trg = .Resize(trg.Row - .Row + 1)
End With
trg.Replace What:=fnd, Replacement:=rplc, LookAt:=xlPart, _
MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False 
Dim Data As Variant: Data = trg.Value
Dim cValue As Variant
For i = 1 To UBound(Data, 1)
cValue = Data(i, 1)
If Not IsError(cValue) Then
If Len(cValue) > 9 Then
cValue = Right(cValue, 9)
If IsNumeric(cValue) Then
Data(i, 1) = cValue
Else
Data(i, 1) = ""
End If
'Else ' Len(cValue) is lte 9
End If
'Else ' error value
End If
Next i
trg.Value = Data
End Sub