在命名范围内搜索和替换-VBA for Excel

Question

我有一个包含约一百个命名范围的Excel电子表格。 我想运行一个脚本以在那些命名范围内找到某些字符串，并将其替换为另一个字符串。 问题在于更改命名范围的名称，同时保持基础单元格引用相同。

标准的Excel搜索和替换功能不适用于命名范围。

例如：命名范围=“ Turnover_Shop_ABC_2018”，我想将文本“ Shop_ABC”替换为“ Store_XYZ”。 我需要搜索和替换一些字符串，但是宏不需要太复杂：我不介意运行脚本并每次手动更新搜索字符串。

任何帮助非常感谢！

Answer 1

这就像遍历要更改的名称列表并执行以下操作一样简单：

ActiveWorkbook.Names("SomeName").Name = "SomeOtherName"

这是一个例程，可以为您完成此操作：

Option Explicit
Option Compare Text

Sub ReplaceNamePart(vMapping As Variant)
Dim nm  As Name
Dim sOld As String
Dim sNew As String
Dim i As Long


For i = 1 To UBound(vMapping)
    sOld = vMapping(i, 1)
    sNew = vMapping(i, 2)
    For Each nm In ActiveWorkbook.Names
        If InStr(nm.Name, sOld) > 1 Then nm.Name = Replace(nm.Name, sOld, sNew)
    Next nm
Next i

End Sub

...这是您的称呼方式：

Sub ReplaceNamePart_Caller()
Dim v As Variant

v = Range("NameChange").ListObject.DataBodyRange
ReplaceNamePart v
End Sub

该Caller子要求您将名称更改映射放在Excel表中，如下所示：

...并命名为Table NameChange：

这是运行代码之前的外观示例：

...结果如下：

Answer 2

您可以使用输入框尝试类似的操作，以输入要查找和替换的字符串：

    Sub search_replace__string()

Dim nm

For Each nm In ActiveWorkbook.Names
On Error Resume Next

If nm.RefersToRange.Parent.Name <> ActiveSheet.Name Then GoTo thenextnamedrange

MsgBox nm.Name

With ThisWorkbook.ActiveSheet.Range(nm.Name)

Dim i, j, FirstRow, FirstCol, LastRow, LastCol As Long
Dim SelText, RepText, myStr As String

FirstRow = .Row
FirstCol = .Column
LastRow = .End(xlDown).Row
LastCol = .End(xlToRight).Column

 SelText = InputBox("Enter String", "Search for...")
 RepText = InputBox("Enter String", "Replace with...")
 If SelText = "" Then
 MsgBox "String not found"
 Exit Sub
 End If
 For j = FirstCol To LastCol
 For i = FirstRow To LastRow
 If InStr(Cells(i, j), SelText) Then

    myStr = Cells(i, j).Value
    Cells(i, j).Value = Replace(myStr, SelText, RepText)

 End If
 Next
 Next

End With

thenextnamedrange:
Next nm

End Sub