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

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 替换为 Type:=2 以代替范围，但没有成功。请帮助我突破 255 个字符的限制。

示例数据： Google Spreadsheet

Answer 1

我不是 100% 清楚您拥有哪些数据以及您想要做什么，但我认为如果您使用以下方法，您会取得更大的成功：

• MSDN : Replace Function (VBA)

...而不是：

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

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

您的代码只需稍作改动即可适应Replace 函数。

Answer 2

替换全细胞内容

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

1. 将替换读入字典
2. 将数据读入数组
3. 在数组中替换
4. 将数组写回单元格

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

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