如何用vba实现vlookup的增强功能？

好好学习下2018

→

姓名相同，然后复制所有列到表2

zjzyj

如果一对多呢，同一个人在sheet1表里有两条以上记录，怎么写到sheet2表呢？

lsc900707

了解字典的功能！

opel-wong

代码如下，供参考：

天狼骑士2013

楼上是啥编辑器，这么好看

3190496160

Sub 匹配()
Dim d As Object
Set d = CreateObject("scripting.dictionary")
ar = Sheet1.[a1].CurrentRegion
For i = 2 To UBound(ar)
    If Trim(ar(i, 6)) <> "" Then
        d(Trim(ar(i, 6))) = i
    End If
Next i
With Sheet2
    r = .Cells(Rows.Count, 1).End(xlUp).Row
    .Range("c2:j" & r) = Empty
    br = .Range("a1:j" & r)
    For i = 2 To UBound(br)
        If Trim(br(i, 1)) <> "" Then
            n = d(Trim(br(i, 1)))
            If n <> "" Then
                For j = 1 To UBound(ar, 2)
                    br(i, j + 2) = ar(n, j)
                Next j
            End If
        End If
    Next i
    .Range("a1:j" & r) = br
End With
MsgBox "ok!"
End Sub

3190496160

vlookup复制多列.rar (19.49 KB, 下载次数: 148)

2021-3-7 10:47 上传

点击文件名下载附件

xiangbaoan

天狼骑士2013 发表于 2021-3-7 10:26
楼上是啥编辑器，这么好看

sublime text

好好学习下2018

感谢各位大佬，解决大问题了，感谢感谢

王正林

Sub bydic()
    Dim d As Object, i%, j%, t, arr, brr
    Set d = CreateObject("scripting.dictionary")
    arr = Sheet1.[a1].CurrentRegion
    brr = Sheet2.[a1].CurrentRegion
    For i = 2 To UBound(arr)
        For j = 1 To UBound(arr, 2)
            d(arr(i, 6)) = d(arr(i, 6)) & "|" & arr(i, j)
        Next
        d(arr(i, 6)) = Mid(d(arr(i, 6)), 2, 99)
    Next
    t = d.items
    For i = 2 To UBound(brr)
        If d.exists(brr(i, 1)) Then
            For j = 3 To UBound(brr, 2)
                brr(i, j) = Split(t(i - 2), "|")(j - 3)
            Next
        End If
    Next
    Sheet2.[a8].Resize(UBound(brr), UBound(brr, 2)) = brr
End Sub