加快电池更换 VBA
Speed up Cell replacement VBA
我有一些代码可以在一列中格式化 phone 数字,从某种意义上说:
- 如果中间有空格,则删除它们
-之后,从右边开始取9个数字,并检查它是否是一个整数,如果是,则将其放入单元格中。
问题是完成所有替换(3000 个单元格,其中大部分为空白)需要将近 6-7 秒。知道如何加快速度吗?
非常感谢
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```
使用数组替换单元格
- 您可以 'apply' 删除范围内的空格。对于剩余的作业,将范围值写入数组,修改它们并将它们写回范围。
编辑:
- 请注意,我添加了三个缺少的
Replace
参数,因为 False
不是它们的默认值:MatchCase
当然,最后两个不清楚。 SearchOrder
和 MatchByte
在这种情况下并不重要。阅读更多相关信息 here。
代码
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
我有一些代码可以在一列中格式化 phone 数字,从某种意义上说: - 如果中间有空格,则删除它们 -之后,从右边开始取9个数字,并检查它是否是一个整数,如果是,则将其放入单元格中。
问题是完成所有替换(3000 个单元格,其中大部分为空白)需要将近 6-7 秒。知道如何加快速度吗?
非常感谢
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```
使用数组替换单元格
- 您可以 'apply' 删除范围内的空格。对于剩余的作业,将范围值写入数组,修改它们并将它们写回范围。
编辑:
- 请注意,我添加了三个缺少的
Replace
参数,因为False
不是它们的默认值:MatchCase
当然,最后两个不清楚。SearchOrder
和MatchByte
在这种情况下并不重要。阅读更多相关信息 here。
代码
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