我想用vba实现vlookup功能。我不会写代码，希望大神直接附上代码，代码里面有注释...

cj19

各位大神，如附件的表格“示例表格”所见，我想用vba实现vlookup功能，将工作簿“数据源”的数据（可售数量、预留数量、在途数量）抓取到工作簿“最终表”对应的列上。以工作簿“最终表”和“数据源”的第一列为查到对象。

我不会写代码，希望大神直接附上代码，代码里面有注释的话更好。我也想学一下

3190496160

可售数据在数据源中有两列，你需要的是哪一列？？？

3190496160

Sub 匹配()
Dim d As Object
Set d = CreateObject("scripting.dictionary")
Dim ar As Variant
Dim br As Variant
br = Sheets("数据源").[a1].CurrentRegion
With Sheets("最终表")
    ws = .Cells(Rows.Count, 1).End(xlUp).Row
    .Range("b2:d" & ws) = Empty
    ar = .Range("a1:d" & ws)
    For i = 2 To UBound(ar)
        If Trim(ar(i, 1)) <> "" Then
            d(Trim(ar(i, 1))) = i
        End If
    Next i
    For i = 2 To UBound(br)
        m = d(Trim(br(i, 1)))
        If m <> "" Then
            ar(m, 2) = br(i, 3) '''预留数据目前取得是C列，可根据你自己需要修改br数组的列号即可
            ar(m, 3) = br(i, 9)
            ar(m, 4) = br(i, 12)
        End If
    Next i
     .Range("a1:d" & ws) = ar
End With
MsgBox "ok!"
End Sub

3190496160

示例表格.zip (15.82 KB, 下载次数: 9)

2020-2-9 10:06 上传

点击文件名下载附件

cj19

3190496160 发表于 2020-2-9 09:57
可售数据在数据源中有两列，你需要的是哪一列？？？

不好意思，可售数据多做了一列。这个为了表达清楚我要达到的效果特意做的示例文件。
我们抓取C列就可以，G列可以忽略。删除掉都可以。

cj19

3190496160 发表于 2020-2-9 10:05
Sub 匹配()
Dim d As Object
Set d = CreateObject("scripting.dictionary")

多谢多谢，我先研究一下里面的逻辑。不明白再想您请教哈。

cj19

3190496160 发表于 2020-2-9 10:05
Sub 匹配()
Dim d As Object
Set d = CreateObject("scripting.dictionary")

里面的语句不太看得懂，只知道改数组里面的列数，但我改了之后报错。
所以我根据真实数据的列数重新做了“示例表格v2”，您能帮我看看问题在哪里吗？ 顺便帮我改下代码。谢谢！！

最终目的：将数据源表的"可售数量,预留数量,入库数量,建票未发货",提取到最终表对应的列。


我改后的代码，如下：
Sub 匹配()
Dim d As Object
Set d = CreateObject("scripting.dictionary")
Dim ar As Variant
Dim br As Variant
br = Sheets("数据源").[a1].CurrentRegion
With Sheets("最终表")
    ws = .Cells(Rows.Count, 1).End(xlUp).Row
    .Range("b2:d" & ws) = Empty
    ar = .Range("a1:d" & ws)
    For i = 2 To UBound(ar)
        If Trim(ar(i, 1)) <> "" Then
            d(Trim(ar(i, 1))) = i
        End If
    Next i
    For i = 2 To UBound(br)
        m = d(Trim(br(i, 1)))
        If m <> "" Then
            ar(m, 4) = br(i, 11) '''预留数据目前取得是C列，可根据你自己需要修改br数组的列号即可
            ar(m, 5) = br(i, 13)
            ar(m, 6) = br(i, 17)
            ar(m, 7) = br(i, 16)
        End If
    Next i
     .Range("a1:d" & ws) = ar
End With
MsgBox "ok!"
End Sub

3190496160

既然是求助，一开始就要表达自己的真是意图，不要考验别人的耐性，没有多少人愿意不愿其烦的做义务的
Sub 匹配()
Dim d As Object
Set d = CreateObject("scripting.dictionary")
Dim ar As Variant
Dim br As Variant
br = Sheets("数据源").[a1].CurrentRegion
With Sheets("最终表")
    ws = .Cells(Rows.Count, 1).End(xlUp).Row
    .Range("b2:d" & ws) = Empty
    ar = .Range("a1:g" & ws)
    For i = 2 To UBound(ar)
        If Trim(ar(i, 1)) <> "" Then
            d(Trim(ar(i, 1))) = i
        End If
    Next i
    For i = 2 To UBound(br)
        m = d(Trim(br(i, 1)))
        If m <> "" Then
            ar(m, 4) = br(i, 11) '''预留数据目前取得是C列，可根据你自己需要修改br数组的列号即可
            ar(m, 5) = br(i, 13)
            ar(m, 6) = br(i, 17)
            ar(m, 7) = br(i, 16)
        End If
    Next i
     .Range("a1:g" & ws) = ar
End With
MsgBox "ok!"
End Sub

cj19

3190496160 发表于 2020-2-11 17:25
既然是求助，一开始就要表达自己的真是意图，不要考验别人的耐性，没有多少人愿意不愿其烦的做义务的
Sub  ...

是的是的，之前没有表达清楚。感谢您的帮助

cj19

3190496160 发表于 2020-2-11 17:25
既然是求助，一开始就要表达自己的真是意图，不要考验别人的耐性，没有多少人愿意不愿其烦的做义务的
Sub  ...

这个代码会把“最终表”的第2和第3列的数据清空了。