Question

我使用的是查找和替换，简单的VBA代码，如下所示：

Sub MultiFindNReplace()
'Update 20140722
Dim Rng As Range
Dim InputRng As Range, ReplaceRng As Range
xTitleId = "KutoolsforExcel"
Set InputRng = Application.Selection
Set InputRng = Application.InputBox("Original Range ", xTitleId, 
InputRng.Address, Type:=8)
Set ReplaceRng = Application.InputBox("Replace Range :", xTitleId, Type:=8)
Application.ScreenUpdating = False
For Each Rng In ReplaceRng.Columns(1).Cells
InputRng.Replace what:=Rng.Value, replacement:=Rng.Offset(0, 1).Value
Next
Application.ScreenUpdating = True
End Sub

但是，数据集超过685,000个值，这会使我的Excel文档崩溃。我已经尝试过使用错误捕获和其他方法来查找和替换。

两列都在sheet2中。要更换的列是第10列，列和替换在第17和18列中。

数据看起来像这样

银行时间 银行时间 转换后的分数

999               999                 5
5                 1                   4
27                2                   4
3                 3                   2
...               ...                 ...
999               207                 1.3

希望用第2列中每个第2列的转换得分（第3列）替换所有包含686950个条目的第一列，其中包含80个不同月度条目的银行时间。

Answer 1

您可能有一个基于替换hte工作表中的值的计算周期。这可能是由于在任何打开的工作簿中引用inputRng中的一个或多个单元格或易失性公式（例如，INDIRECT，ADDRESS，TODAY，NOW等）的先例公式。您可能还在工作表的代码表（例如Worksheet_Change等）或工作簿的代码页（例如Workbook_SheetChange等）中包含依赖于事件的代码。

在关闭屏幕更新的同时关闭计算并禁用事件。

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False

'... all of the processing code

Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

您的子程序也可能受益于在记忆中工作＆＃39;并且在执行所有替换后替换值 en masse 。使用以下方法，我在i5 Surface Pro上的效率提高了约30％。

Option Explicit

Sub multiFindNReplace2()
    Dim rng As Variant, xTitleId As String, r As Long
    Dim dataRng As Variant, mtch As Variant, inputRng As Range, replaceRng As Range

    xTitleId = "KutoolsforExcel"
    Set inputRng = Application.InputBox(PROMPT:="Original Range:", Title:=xTitleId, Default:=Selection.Address, Type:=8)
    rng = Application.InputBox(PROMPT:="Replacement Range:", Title:=xTitleId, Default:="$M$2:$N$81", Type:=8).Value2
    dataRng = inputRng.Value2


    Debug.Print Timer
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False

    For r = LBound(rng, 1) To UBound(rng, 1)
        mtch = Application.Match(rng(r, 1), dataRng, 0)
        Do While Not IsError(mtch)
            dataRng(mtch, 1) = rng(r, 2)
            mtch = Application.Match(rng(r, 1), dataRng, 0)
        Loop
    Next r

    inputRng.Resize(UBound(dataRng, 1), UBound(dataRng, 2)) = dataRng

    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    Debug.Print Timer

End Sub

查找和替换不断崩溃

1 个答案: