查找和replace不断崩溃

我正在使用一个查找和replace，简单的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文档崩溃。 我试图把错误捕获和其他方法来查找和replace。

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

数据看起来像这样

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

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

outlook将具有686950个条目的第一列全部replace为每个列2的变换得分（第3列），其具有用于80个不同月份条目的银行时间。

Answer 1

基于replace工作表中的值，可能会有一个计算周期。 这可能是由于在任何打开的工作簿中引用inputRng中的一个或多个单元格或挥发性公式（例如INDIRECT，ADDRESS，TODAY，NOW等）的先例公式。 工作表代码表（例如Worksheet_Change等）或工作簿的代码页（例如Workbook_SheetChange等）中可能还有与事件相关的代码。

在closures屏幕更新的同时，closures计算并closures事件。

 Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Application.EnableEvents = False '... all of the processing code Application.EnableEvents = True Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = True 

您的子程序也可以从“内存中”工作中受益，并且一旦所有的replace已经完成，就可以全部replace这些值。 我使用以下方法在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