在命名范围内搜索和替换 - VBA for Excel
Search and Replace within Named Ranges - VBA for Excel
我有一个 Excel 电子表格,其中包含大约一百个命名范围。我想要 运行 一个脚本来在这些命名范围内查找某些字符串并将其替换为另一个字符串。问题在于更改命名范围的名称,同时保持底层单元格引用相同。
标准 Excel 搜索和替换功能不适用于命名范围。
例如:命名范围 = "Turnover_Shop_ABC_2018",我想将文本 "Shop_ABC" 替换为 "Store_XYZ"。我需要搜索和替换一些字符串,但宏不需要很复杂:我不介意 运行 每次都手动更新脚本和更新搜索字符串。
非常感谢任何帮助!
这应该很简单,只需遍历要更改的姓名列表并执行以下操作:
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 sub 要求您将您的姓名更改映射放在 Excel Table 中,如下所示:
...并命名 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
我有一个 Excel 电子表格,其中包含大约一百个命名范围。我想要 运行 一个脚本来在这些命名范围内查找某些字符串并将其替换为另一个字符串。问题在于更改命名范围的名称,同时保持底层单元格引用相同。
标准 Excel 搜索和替换功能不适用于命名范围。
例如:命名范围 = "Turnover_Shop_ABC_2018",我想将文本 "Shop_ABC" 替换为 "Store_XYZ"。我需要搜索和替换一些字符串,但宏不需要很复杂:我不介意 运行 每次都手动更新脚本和更新搜索字符串。
非常感谢任何帮助!
这应该很简单,只需遍历要更改的姓名列表并执行以下操作:
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 sub 要求您将您的姓名更改映射放在 Excel Table 中,如下所示:
...并命名 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