加速单元更换 VBA

编程问答 2022-05-26

问题描述

我有一些代码可以格式化列中的电话号码，从某种意义上说： - 如果中间有空格，则删除它们 -之后，从右边开始取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```

解决方法

使用数组替换单元格

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

编辑：

  • 请注意，我添加了三个缺失的 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
cellcellcellexcelexcelreplacereplacereplacevba