加快 Cell 更换 VBA答案

【问题标题】：Speed up Cell replacement VBA加快 Cell 更换 VBA
【发布时间】：2021-05-13 09:42:50
【问题描述】：

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

【问题讨论】：

哪一部分？替换？还是for循环？看起来您的 for 循环正在跳过长度小于九的单元格，应该跳过空白。注意：您可以从任何看到它的地方删除= True。这是双重评价。模式是If Boolean Then。
每次写入工作表都会提示重新计算相关单元格，在写入单元格时，Excel 会尝试在两个 VBA 指令之间插入以重新绘制工作表 - 您可以“加快”通过在循环之前关闭重新计算和重新绘制，然后再将它们重新打开来执行代码。请参阅 Application.Calculation 和 Application.ScreenUpdating。如果您正在运行 Worksheet_Change 事件处理程序，请也禁用事件（请参阅 Application.EnableEvents）。
非常好，非常感谢！
仅供参考，您可能会发现将几乎个电话号码删除的条目令人沮丧，因为它们不是“完美的”，没有机会更正它们，因此最好突出问题条目而不是删除它们？
嗨蒂姆，你完全正确。非常感谢您指出这一点

标签： excel vba replace cell

【解决方案1】：

使用数组替换单元格

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

编辑：

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

【讨论】：

哇非常感谢！！这真的很快，漂亮又干净！