使用vlookup查找列中的匹配值

Question

我有一个列A，里面有重复的值。我想写一个vlookup，它执行以下操作;如果A内部有重复值，则该列相同行的B值应覆盖到B列中相同行的前一个A值。

这方面的一个例子;

    A         B
1  Anna  | 23 years old
2  Anna  | 34 years old

因此，由于A列中的值匹配，因此B1中的值应自动为34年。

我该怎么做？

Answer 1

试试这个：

js.erb

见图片参考：

编辑＃1 的 ------------------------------------------------------------------------

Sub Demo()
    Dim dict1 As Object
    Dim c1 As Variant
    Dim i As Long, lastRow As Long
    Dim strFound As Range
    Dim strFirst As String, copyVal As String

    Set dict1 = CreateObject("Scripting.Dictionary")

    lastRow = Cells(Rows.Count, "A").End(xlUp).Row  '-->get last row with data in column A
    'enter unique values of column A in dict1
    c1 = Range("A1:A" & lastRow)
    For i = 1 To UBound(c1, 1)
        dict1(c1(i, 1)) = 1
    Next i

    For Each k In dict1.keys
        'find last occurrence of each value in dict1
        Set rngFound = Columns("A").Find(k, Cells(Rows.Count, "A"), xlValues, xlWhole, , xlPrevious)
        If Not rngFound Is Nothing Then
            'get column B value for found string
            copyVal = rngFound.Offset(0, 1).Value
            strFirst = rngFound.Address
            Do
                'find all the occurrences of each value in dict1
                Set rngFound = Columns("A").Find(k, rngFound, xlValues, xlWhole, , xlPrevious)
                'change value in column B for each occurrence
                rngFound.Offset(0, 1).Value = copyVal
            Loop While rngFound.Address <> strFirst
        End If
    Next k
End Sub

编辑＃2 的 ------------------------------------------------------------------------

Sub Demo()
    Application.ScreenUpdating = False
    Dim dict1 As Object, dict2 As Object
    Dim c1 As Variant
    Dim i As Long, lastRow As Long
    Dim strFound As Range, delRange As Range
    Dim strFirst As String, copyVal As String

    Set dict1 = CreateObject("Scripting.Dictionary")
    Set dict2 = CreateObject("Scripting.Dictionary")

    lastRow = Cells(Rows.Count, "A").End(xlUp).Row  '-->get last row with data in column A
    'enter unique values of column A in dict1
    c1 = Range("A1:A" & lastRow)
    For i = 1 To UBound(c1, 1)
        dict1(c1(i, 1)) = 1
    Next i

    For Each k In dict1.keys
        'find last occurrence of each value in dict1 and save row number in dict2
        Set rngFound = Columns("A").Find(k, , xlValues, xlWhole, , xlPrevious)
        If Not rngFound Is Nothing Then
            dict2.add rngFound.Row, 1
        End If
    Next k

    'check for column A if row number exists in dict2, if not then add to a range for deletion
    For i = 1 To lastRow
        If Not dict2.exists(Cells(i, 1).Row) Then
            Debug.Print Cells(i, 1).Address
            If delRange Is Nothing Then
                Set delRange = Cells(i, 1)
            Else
                Set delRange = Union(delRange, Cells(i, 1))
            End If
        End If
    Next i

    'delete the range
    If Not delRange Is Nothing Then
        delRange.EntireRow.Delete
    End If
    Application.ScreenUpdating = True
End Sub