-1

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

2 回答 2

0

像这样的东西：

 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
于 2018-06-02T19:42:07.747 回答
0

或者基于匹配整个单元格内容的以下内容（您可以更改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
于 2018-06-03T05:54:37.197 回答