时间戳

首页 > 解决方案 > 在一列中查找并替换为 2 列中的数据

excel - 在一列中查找并替换为 2 列中的数据

问题描述

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

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

两张纸上的名字是一样的。在下面的代码中，我将name替换为full name，但我还想添加 ID。

预期结果的 Excel 预览

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

标签： excelvba

解决方案

这是我将如何做到这一点。

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

推荐阅读