Question

在我的工作簿中，有一张包含缩写/完整字符串对列表的表格（例如“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

Answer 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

Answer 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

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

2 个答案: