Question

我想用“列表”表中的相应条目替换“数据”表中的列A和B。

我有一个工作表，其中在数据表的B列中列出了数百个名称。
我想用 listsheet 中列出的名称替换这些名称，该名称由三列组成：
name，ID，full name

两个表中的名称相同。在下面的代码中，我用全名替换 name ，但我也想添加ID。

Sub myReplace()

        Dim myDataSheet As Worksheet
        Dim myReplaceSheet As Worksheet
        Dim myLastRow As Long
        Dim myRow As Long
        Dim myFind As String
        Dim myReplace As String

    '   Specify name of Data sheet
        Set myDataSheet = Sheets("Wedstr")

    '   Specify name of Sheet with list of replacements
        Set myReplaceSheet = Sheets("List")

    '   Assuming list of replacement start in column A on row 2, find last entry in list
        myLastRow = myReplaceSheet.Cells(Rows.Count, "B").End(xlUp).Row

        Application.ScreenUpdating = False

    '   Loop through all list of replacments
        For myRow = 2 To myLastRow
    '       Get find and replace values (from columns A and B)
            myFind = myReplaceSheet.Cells(myRow, "A")
            myReplace = myReplaceSheet.Cells(myRow, "B")
    '       Start at top of data sheet and do replacements
            myDataSheet.Activate
            Range("A1").Select
    '       Ignore errors that result from finding no matches
            On Error Resume Next
    '       Do all replacements on column A of data sheet
            With Application.ReplaceFormat.Interior
            .PatternColorIndex = xlAutomatic
            .ThemeColor = xlThemeColorAccent4
            .TintAndShade = 0
            .PatternTintAndShade = 0
            End With
            Columns("B").Replace What:=myFind, Replacement:=myReplace, LookAt:=xlWhole, _
                SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
                ReplaceFormat:=True
            Columns("D").Replace What:=myFind, Replacement:=myReplace, LookAt:=xlWhole, _
                SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
                ReplaceFormat:=True

    '       Reset error checking
            On Error GoTo 0
        Next myRow

        Application.ScreenUpdating = True

        MsgBox "Replacements complete!"

    End Sub

Answer 1

这就是我要怎么做。

Dim myDataSheet As Worksheet
Dim myReplaceSheet As Worksheet
Dim myLastRow As Long
Dim myRow As Long

Dim namedict As Object
Dim namearr(1) As Variant
Dim name As String

Set namedict = CreateObject("Scripting.Dictionary")

Set myDataSheet = Sheets("Wedstr")
Set myReplaceSheet = Sheets("List")

myLastRow = myReplaceSheet.Cells(Rows.Count, "B").End(xlUp).Row
with myreplacesheet
    For myRow = 2 To myLastRow 
        name = .cells(myrow, "A").value
        if not namedict.exists(name) then 'Make sure it doesn't error out if duplicates exist
            namearr(0) = .cells(myrow, "B").value
            namearr(1) = .cells(myrow, "C").value
            namedict.add name, namearr
        end if
     next
end with

with mydatasheet
     mylastrow = .cells(rows.count, "A").end(xlup).row
     for myrow = 2 to mylastrow
         name = .cells(myrow, "A").value
         if namedict.exists(name) then 'Make sure name is in dictionary
             .cells(myrow, "A").value = namedict(name)(0)
             .cells(myrow, "B").value = namedict(name)(1)
         end if
     next
end with

我不确定我的栏是否正确，请注意。

如果要保留当前设置，可以查看Range.Resize属性。以下是该文档：https://docs.microsoft.com/en-us/office/vba/api/excel.range.resize

在一列中查找并替换为两列中的数据

1 个答案: