Question

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

来源： Extend Office - How To Find And Replace Multiple Values At Once In Excel?

数据类型： Using the Excel Application.InputBox method

我尝试将Type:=8的{{1}}替换为文本，而不是范围，但是没有用。请通过255个字符的限制来帮助我。

示例数据： Google Spreadsheet

Answer 1

我尚不清楚您拥有的数据和正在尝试的数据的百分比为100％，但我认为，如果您使用以下方法，将会获得更大的成功：

MSDN：Replace Function (VBA)

...而不是：

办公室支持：Range.Replace Method (Excel)

第二个基本上是一个工作表函数，因此受到第一个没有的各种限制。

您的代码只需要进行少量更改即可适应Replace函数。

Answer 2

替换整个单元格内容

所以我要替换整个单元格内容的想法是：

将替换项读入词典
将数据读入数组
替换为数组
将数组写回单元格

我选择数组是因为使用数组比使用单元格要快得多。因此，我们只有一个慢单元读取和一个慢单元写入，并且使用数组的速度很快。

Option Explicit

Public Sub MultiReplaceWholeCells()
    Const xTitleId As String = "KutoolsforExcel"

    Dim InputRange As Range
    Set InputRange = Range("A2:F10") 'Application.InputBox("Original Range ", xTitleId, InputRng.Address, Type:=8)

    Dim ReplaceRange As Range
    Set ReplaceRange = Range("A12:B14") 'Application.InputBox("Original Range ", xTitleId, InputRng.Address, Type:=8)

    Dim Replacements As Object
    Set Replacements = CreateObject("Scripting.Dictionary")

    'read replacements into an array
    Dim ReplaceValues As Variant
    ReplaceValues = ReplaceRange.Value

    'read replacements into a dictionary
    Dim iRow As Long
    For iRow = 1 To ReplaceRange.Rows.Count
        Replacements.Add ReplaceValues(iRow, 1), ReplaceValues(iRow, 2)
    Next iRow

    'read values into an array
    Dim Data As Variant
    Data = InputRange.Value

    'loop through array data and replace whole data
    Dim r As Long, c As Long
    For r = 1 To InputRange.Rows.Count
        For c = 1 To InputRange.Columns.Count
            If Replacements.Exists(Data(r, c)) Then
                Data(r, c) = Replacements(Data(r, c))
            End If
        Next c
    Next r

    'write data from array back to range
    InputRange.Value = Data
End Sub

替换部分单元格内容

要替换单元格的一部分，这会更慢：

Option Explicit

Public Sub MultiReplaceWholeCells()
    Const xTitleId As String = "KutoolsforExcel"

    Dim InputRange As Range
    Set InputRange = Range("A2:F10") 'Application.InputBox("Original Range ", xTitleId, InputRng.Address, Type:=8)

    Dim ReplaceRange As Range
    Set ReplaceRange = Range("A12:B14") 'Application.InputBox("Original Range ", xTitleId, InputRng.Address, Type:=8)

    'read replacements into an array
    Dim ReplaceValues As Variant
    ReplaceValues = ReplaceRange.Value

    'read values into an array
    Dim Data As Variant
    Data = InputRange.Value

    'loop through array data and replace PARTS of data
    Dim r As Long, c As Long
    For r = 1 To InputRange.Rows.Count
        For c = 1 To InputRange.Columns.Count
            Dim iRow As Long
            For iRow = 1 To ReplaceRange.Rows.Count
                Data(r, c) = Replace(Data(r, c), ReplaceValues(iRow, 1), ReplaceValues(iRow, 2))
            Next iRow
        Next c
    Next r

    'write data from array back to range
    InputRange.Value = Data
End Sub

如果您只需要替换整个单元格内容，请使用第一个应该更快的内容。

同时执行两种替换类型的程序

或者如果两者都需要编写一个过程，那么可以选择是否需要替换xlWhole或xlPart。甚至可能会有不同的输出范围。

Option Explicit

Public Sub TestReplace()
    Const xTitleId As String = "KutoolsforExcel"

    Dim InputRange As Range
    Set InputRange = Range("A2:F10") 'Application.InputBox("Original Range ", xTitleId, InputRng.Address, Type:=8)

    Dim ReplaceRange As Range
    Set ReplaceRange = Range("A12:B14") 'Application.InputBox("Original Range ", xTitleId, InputRng.Address, Type:=8)


    MultiReplaceInCells InputRange, ReplaceRange, xlWhole, Range("A20") 'replace whole to output range
    MultiReplaceInCells InputRange, ReplaceRange, xlPart, Range("A30") 'replace parts to output range

    MultiReplaceInCells InputRange, ReplaceRange, xlWhole 'replace whole in place
End Sub

Public Sub MultiReplaceInCells(InputRange As Range, ReplaceRange As Range, Optional LookAt As XlLookAt = xlWhole, Optional OutputRange As Range)
    'read replacements into an array
    Dim ReplaceValues As Variant
    ReplaceValues = ReplaceRange.Value

    'read values into an array
    Dim Data As Variant
    Data = InputRange.Value

    Dim r As Long, c As Long, iRow As Long

    If LookAt = xlPart Then
        'loop through array data and replace PARTS of data
        For r = 1 To InputRange.Rows.Count
            For c = 1 To InputRange.Columns.Count
                For iRow = 1 To ReplaceRange.Rows.Count
                    Data(r, c) = Replace(Data(r, c), ReplaceValues(iRow, 1), ReplaceValues(iRow, 2))
                Next iRow
            Next c
        Next r
    Else
        'read replacements into a dictionary
        Dim Replacements As Object
        Set Replacements = CreateObject("Scripting.Dictionary")

        For iRow = 1 To ReplaceRange.Rows.Count
            Replacements.Add ReplaceValues(iRow, 1), ReplaceValues(iRow, 2)
        Next iRow

        'loop through array data and replace WHOLE data
        For r = 1 To InputRange.Rows.Count
            For c = 1 To InputRange.Columns.Count
                If Replacements.Exists(Data(r, c)) Then
                    Data(r, c) = Replacements(Data(r, c))
                End If
            Next c
        Next r
    End If

    'write data from array back to range
    If OutputRange Is Nothing Then
        InputRange.Value = Data
    Else
        OutputRange.Resize(InputRange.Rows.Count, InputRange.Columns.Count).Value = Data
    End If
End Sub

如何绕过VBA批量替换功能的255个字符限制？

2 个答案:

替换整个单元格内容

替换部分单元格内容

同时执行两种替换类型的程序