Vlookup代码(使用Dictionary)更新相同的行值

时间:2017-01-19 04:33:45

标签: excel vba excel-vba

我有一个vlookup代码,如果结果与源表匹配,它将更新目标列中的文本“UG”。

示例:代码将“工作表B”与“工作表A”进行比较,如果在“工作表A”中找到匹配项,则会更新工作表A中列中的文本“UG”。

我想在这里做一个小修改。

我没有更新表A中的文本“UG”,而是想更新col B中“Sheet B”中的值。

Sub UGvlookup()

Dim cl As Range, Dic As Object

Set Dic = CreateObject("Scripting.Dictionary"): Dic.Comparemode = vbTextCompare

With Sheets("Sheet A")
    For Each cl In .Range("B2:B" & .Cells(Rows.count, "C").End(xlUp).Row)
        If Not Dic.exists(cl.Value) Then Dic.Add cl.Value, cl.Row
    Next cl
End With

With Sheets("Sheet B")
    For Each cl In .Range("A2:A" & .Cells(Rows.count, "A").End(xlUp).Row)
        If Dic.exists(cl.Value) Then
            Sheets("Latency").Cells(Dic(cl.Value), 17) = "UG"
        End If
        If Dic.exists(cl.Value) Then
            Sheets("Sheet A").Cells(Dic(cl.Value), 17) = "UG"
            Dic.Remove (cl.Value)
        End If
    Next cl
End With

1 个答案:

答案 0 :(得分:0)

也许你在此之后:

Sub UGvlookup()

    Dim cl As Range, Dic As Object

    Set Dic = CreateObject("Scripting.Dictionary"): Dic.CompareMode = vbTextCompare

    With Sheets("Sheet A")
        For Each cl In .Range("B2:B" & .Cells(.Rows.count, "C").End(xlUp).Row)
            Dic.Item(cl.Value) = cl.Row
        Next cl
    End With

    With Sheets("Sheet B")
        For Each cl In .Range("A2:A" & .Cells(.Rows.count, "A").End(xlUp).Row)
            If Dic.Exists(cl.Value) Then
                Sheets("Latency").Cells(Dic(cl.Value), 17) = "UG"
                Sheets("Sheet A").Cells(Dic(cl.Value), 17) = cl.Offset(, 1) '<--| write in sheet A the value of sheet B cell adjacent to the "current" one
                Dic.Remove (cl.Value)
            End If
        Next cl
    End With

End Sub