这应该很简单，只需迭代要更改的名称列表并执行以下操作：

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

调用者子程序要求您将名称更改Map放入Excel表中，如下所示：

...并将其命名为Table NameChange：

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

结果是这样的

你可以尝试用输入框输入字符串来查找和替换：

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