在选定单元格内查找并替换多个值

在选定单元格内查找并替换多个值

我想在 Excel 中对某个范围内的多个值运行查找和替换,其中的值来自两列:A 列为原始单词;B 列为翻译。我已经找到了 VBA 代码,可让该功能运行 50%,但此代码会在整个工作表上运行该功能。

理想情况下,我希望能够只在我选择的范围上运行它。如果我还能选择查找范围,那就更好了。

这是我目前使用的。感谢您的帮助!

Sub abbrev()
            Dim abvtab() As Variant
            Dim ltsheet As Worksheet
            Dim datasheet As Worksheet
            Dim lt As Range

            'Change Lookup to the sheet name with your lookup table.
            Set ltsheet = Sheets("Lookup")

            'Change Data to the sheet name with your data.
            Set datasheet = Sheets("Data")

            'Change A2 to the top left cell (not the header) in your lookup table.
            'Change B2 to top right cell.
            Set lt = ltsheet.Range("A1", ltsheet.Range("B1").End(xlDown))

            abvtab = lt

            For i = 1 To UBound(abvtab)
                datasheet.Cells.Replace What:=abvtab(i, 1), Replacement:=abvtab(i, 2), LookAt:=xlPart, _
                    SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, _
                    ReplaceFormat:=False
            Next i
End Sub

答案1

Excel 多项替换

  1. 打开 VBA 编辑器 ( Alt+ F11) 并将以下宏粘贴到任意位置
  2. 设置两列查找范围:第一列是要搜索的值,第二列是要替换的值
  3. 选择您的输入范围,其中的值应被替换,如第一张图片所示
  4. 执行宏 ( Alt+ F8)。

宏会询问您的查找范围在哪里。首先是工作表名称,然后是查找范围地址。仅输入第一列,A1:A2例如以下示例。

就是这样。现在,宏开始遍历所有替换规则,并像
普通的 Excel 搜索和替换 ( Ctrl+ H) 一样将它们应用到您选择的输入范围上。

Input range            Replace rules               Input range after macro

在此处输入图片描述在此处输入图片描述 在此处输入图片描述

Sub MultiReplace()
On Error GoTo errorcatch
Dim arrRules() As Variant

    strSheet = InputBox("Enter sheet name where your replace rules are", _
        "Sheet name", "Sheet1")
    strRules = InputBox("Enter address of replaces rules." & vbNewLine & _
        "But only the first column!", "Address", "A1:A100")

    Set rngCol1 = Sheets(strSheet).Range(strRules)
    Set rngCol2 = rngCol1.Offset(0, 1)
    arrRules = Application.Union(rngCol1, rngCol2)

    For i = 1 To UBound(arrRules)
        Selection.Replace What:=arrRules(i, 1), Replacement:=arrRules(i, 2), _
            LookAt:=xlWhole, MatchCase:=True
    Next i

errorcatch:
End Sub

相关内容