用VBA实现跨表VLOOKUP效果

ShamGod超 · 发表于 2014-7-27 13:07

本帖最后由 ShamGod超于 2014-7-27 13:56 编辑

大神们帮忙看一下，附件中有表1和表2，表1中G列是姓名，表2中A列也是姓名，现在想在表1中实现能自动利用姓名匹配出表2中B列的年龄填充到表1的D列，就相当于VLOOKUO函数的效果，表2的存储路径是”C:\Program Files\表2.xlsx“，大神们帮忙看下怎么才能实现，感谢

Desktop.rar (11.93 KB, 下载次数: 326)

TomingTang · 发表于 2014-7-27 13:46

两个工作簿都要打开，d2函数：=VLOOKUP(G2,'C:\Program Files\[表2.xlsx]Sheet1'!$A:$B,2,0)

ShamGod超 · 发表于 2014-7-27 13:58

TomingTang 发表于 2014-7-27 13:46
两个工作簿都要打开，d2函数：=VLOOKUP(G2,'C:\Program Files\[表2.xlsx]Sheet1'!$A:$B,2,0)

谢谢朋友，我希望用VBA来实现这个功能，公式不太方便

蓝桥玄霜 · 发表于 2014-7-27 15:07

Sub lqxs()
Dim conn, Sql$, Arr, i&, d, Arr1
Set d = CreateObject("Scripting.Dictionary")
On Error GoTo 100
Set conn = CreateObject("adodb.connection")
conn.Open "provider=Microsoft.ACE.OLEDB.12.0;Extended Properties='Excel 12.0';data source=" & ThisWorkbook.Path & "\表2.xlsx"
Sql = "select * from [Sheet1$]"
Sheet1.Activate
Arr = conn.Execute(Sql).getrows
For i = 0 To UBound(Arr, 2)
d(Arr(0, i)) = Arr(1, i)
Next
Arr1 = [g1].CurrentRegion
For i = 2 To UBound(Arr1)
If d.exists(Arr1(i, 1)) Then
Cells(i, 4) = d(Arr1(i, 1))
End If
Next
GoTo 200
100:
MsgBox "没有此数据！"
200:
[a2].Select
conn.Close
Set conn = Nothing
End Sub

复制代码

蓝桥玄霜 · 发表于 2014-7-27 15:10

请见附件。

mmwwdd · 发表于 2014-7-27 15:31

中午喝酒了，记号一下，明天学习

和平168 · 发表于 2014-7-27 16:03

2003版本如何修改

和平168 · 发表于 2014-7-27 16:29

你好，老师，用VBA实现跨表VLOOKUP效果，你给的VBa语句是2007版本，能否给一个2003版本的，谢谢！

追着去学习 · 发表于 2014-7-27 23:36

留下慢慢学习

ni57 · 发表于 2014-7-28 00:27

模仿学习中，谢谢老师

		自动登录	找回密码
密码			免费注册

[求助] 用VBA实现跨表VLOOKUP效果

评分