Vba 根据不同工作表（同一工作簿）中的列表进行搜索/替换

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

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

编辑：在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

大概是这样的：

 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

---

或以下基于匹配整个单元格内容的循环（对于部分匹配，可以更改为

xlPart

），这是一个有效的循环，因为您只循环定义，所以只循环所需的次数。replace仅对目标列的填充行起作用。更换工作一次完成

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

---

请把你目前掌握的密码贴出来。更多信息以及“”和“”，以及更多关于Jon Skeet发布问题的提示。此外，请明确这些缩写是否将是整个单元格内容。您希望避免拾取意外的子字符串匹配，例如，如果查找子字符串匹配，对于堆栈溢出，您不希望查找SOlar…我添加了我尝试使用的代码。似乎发生的是，所有目标列（P-T）中都会发生替换，但它只针对前几个“定义”对。任何洞察都会非常有用。您看到答案了吗？很抱歉，我在“TargetRange.Replace（DefPairsRange（r，0）.Value，DefPairsRange（r，1）.Value”行中看到了“语法错误”。我把“r”标注为什么，朗？太棒了，非常感谢你，先生。工作起来很有魅力。