在命名范围内搜索和替换 - 适用于Excel的VBA

Question

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

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

例如：命名范围=＆＃34; Turnover_Shop_ABC_2018＆＃34;，我想替换文本＆＃34; Shop_ABC＆＃34;使用＆＃34; Store_XYZ＆＃34;。我需要搜索和替换一些字符串，但宏并不需要复杂：我不介意运行脚本并每次手动更新搜索字符串。

非常感谢任何帮助！

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

调用者子要求您将名称更改映射放在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