基于不同工作表（相同工作簿）中的列表搜索/替换答案

【问题标题】：Search/replace based on a list in a different sheet (same workbook)基于不同工作表（相同工作簿）中的列表搜索/替换
【发布时间】：2018-11-12 08:03:39
【问题描述】：

在我的工作簿中，有一张包含缩写/完整字符串对列表的工作表（例如“GG”/“Gotta Go”）。工作表名称为“定义”，列为 C 和 D。该列表将来可能会更新为更多对。

然后在同一个工作簿中有一个不同的工作表，其中包含 5 列（P 到 T）。这些列包含随机行中的缩写，有些行是空的或包含不同的数据。工作表名称为“目标”。有没有办法将 VBA 代码放在一起，通过对列表并用相应的完整字符串替换 cols P 到 T 中的缩写？一些目标列可能包含空单元格，所以如果代码可以检查并跳过空单元格，那就太好了。

编辑：添加由 Mumps 在 Ozgrid 上精心整理的代码。

Sub ReplaceAbbrev() 

Application.ScreenUpdating = False
Dim LastRow1 As Long
Dim LastRow2 As Long
Dim foundDef As Range
Dim def As Range
Dim sAddr As String

LastRow1 = Sheets("Definitions").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
LastRow2 = Sheets("Target").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

For Each def In Sheets("Definitions").Range("C2:C" & LastRow1)
    Set foundDef = Sheets("Target").Range("P2:T" & LastRow2).Find(def, LookIn:=xlValues, lookat:=xlWhole)
    If Not foundDef Is Nothing Then 'if found
        sAddr = foundDef.Address
        Do
            Set foundDef = Sheets("Target").Range("P:T").FindNext(foundDef)
            Sheets("Target").Range(foundDef.Address).Value = Replace(Sheets("Target").Range(foundDef.Address).Value, def, def.Offset(0, 1))

        Loop While Not foundDef Is Nothing
        sAddr = ""
    End If
Next def

Set foundDef = Nothing
Application.ScreenUpdating = True

End Sub

【问题讨论】：

请发布您目前拥有的代码。更多信息请访问help center 以及“How to Ask”和“minimal reproducible example”，以及有关从 Jon Skeet here 发布问题的更多提示。
另外，明确这些缩写是否将是整个单元格内容。您想避免拾取意外的子字符串匹配，例如如果要寻找，对于堆栈溢出，您不想找到 SOlar...
我已经添加了我想要使用的代码。似乎发生的是替换发生在所有目标列 (P-T) 中，但仅针对前几个“定义”对。任何见解都会很有帮助。
你看到答案了吗？
抱歉，我收到“TargetRange.Replace(DefPairsRange(r, 0).Value, DefPairsRange(r, 1).Value)”行的“语法错误”。我将“r”标注为什么，长？

标签： vba excel search replace

【解决方案1】：

类似这样的：

 Dim TargetRange As range, DefPairsRange As range
Set TargetRange = Worksheets("Target").[P:T]   'Set target range

Set DefPairsRange = Worksheets("Definitions").[C1:D10] 'Set definition Range
Set DefPairsRange = range(DefPairsRange, DefPairsRange.End(xlDown))  'extend the range if need it
For R = 1 To DefPairsRange.Rows.count 'iterate through definitions and replace targets
Call TargetRange.Replace(DefPairsRange(R, 0).value, DefPairsRange(R, 1).value)
Next

【讨论】：

【解决方案2】：

或者基于匹配整个单元格内容的以下内容（对于部分匹配，您可以更改为xlPart。）这是一个有效的循环，因为您只循环定义，所以只循环所需的次数。替换仅适用于目标列的填充行。替换是一次性完成的。

Public Sub ReplaceAbbrev()

    Application.ScreenUpdating = False
    Dim LastRow1 As Long
    Dim LastRow2 As Long
    Dim targetRange As Range
    Dim def As Range

    With Worksheets("Definitions")
        LastRow1 = .Cells(.Rows.Count, "C").End(xlUp).Row
    End With

    With Worksheets("Target")
        LastRow2 = .Cells(.Rows.Count, "P").End(xlUp).Row
    End With

    Set targetRange = Worksheets("Target").Range("P2:T" & LastRow2)

    For Each def In Worksheets("Definitions").Range("C2:C" & LastRow1)

        targetRange.Cells.Replace What:=def, Replacement:=def.Offset(0, 1), LookAt:=xlWhole

    Next def

    Application.ScreenUpdating = True

End Sub

【讨论】：

太棒了，非常感谢 QHarr 先生。像魅力一样工作。