[已解决]求VBA代码代替VLOOKUP或者用VBA调用VLOOKUP。

5201314 · 发表于 2012-8-27 17:57

那你教我做网站不？

5201314 · 发表于 2012-8-27 18:02

这个最佳答案由 5201314 给出，感谢 5201314 的回答。

单击隐藏图章

这种表格，先跑单元格，用字典要麻烦一点，跑单元格容易点，写代码费神

Sub test()
Dim LastRow, i, sht As Worksheet
Set sht = Sheets("Sheet1")
LastRow = sht.Range("A" & Rows.Count).End(xlUp).Row
With Sheets("选型表")
For i = 3 To LastRow
If sht.Cells(i, "A") = "" Then sht.Cells(i, "J") = "" Else sht.Cells(i, "J") = Application.WorksheetFunction.VLookup(sht.Cells(i, "A"), .Range("A2:D3"), 2, 0)
If sht.Cells(i, "B") = "" Then sht.Cells(i, "K") = "" Else sht.Cells(i, "K") = Application.WorksheetFunction.VLookup(sht.Cells(i, "B"), .Range("A6:C9"), 2, 0)
If sht.Cells(i, "C") = "" Then sht.Cells(i, "L") = "" Else sht.Cells(i, "L") = Application.WorksheetFunction.VLookup(sht.Cells(i, "C"), .Range("A11:D12"), 2, 0)
If sht.Cells(i, "D") = "" Then sht.Cells(i, "M") = "" Else sht.Cells(i, "M") = Application.WorksheetFunction.VLookup(sht.Cells(i, "D"), .Range("A15:B17"), 2, 0)
If sht.Cells(i, "E") = "" Then sht.Cells(i, "N") = "" Else sht.Cells(i, "N") = Application.WorksheetFunction.VLookup(sht.Cells(i, "E"), .Range("A19:D22"), 2, 0)
If sht.Cells(i, "F") = "" Then sht.Cells(i, "O") = "" Else sht.Cells(i, "O") = Application.WorksheetFunction.VLookup(sht.Cells(i, "F"), .Range("A24:D26"), 2, 0)
If sht.Cells(i, "G") = "" Then sht.Cells(i, "P") = "" Else sht.Cells(i, "P") = Application.WorksheetFunction.VLookup(sht.Cells(i, "G"), .Range("A28:D29"), 2, 0)
If sht.Cells(i, "H") = "" Then sht.Cells(i, "Q") = "" Else sht.Cells(i, "Q") = Application.WorksheetFunction.VLookup(sht.Cells(i, "H"), .Range("A31:D31"), 2, 0)
Next
End With
End Sub

复制代码

5201314 · 发表于 2012-8-27 18:34

Sub test2()
'先引用 Microsoft Scripting Runtime
Dim LastRow, i, sht As Worksheet
Dim arr, brr
Dim dic1 As New Dictionary
Dim dic2 As New Dictionary
Dim dic3 As New Dictionary
Dim dic4 As New Dictionary
Dim dic5 As New Dictionary
Dim dic6 As New Dictionary
Dim dic7 As New Dictionary
Dim dic8 As New Dictionary
Set sht = Sheets("Sheet1")
LastRow = sht.Range("A" & Rows.Count).End(xlUp).Row
ReDim brr(1 To LastRow - 2, 1 To 8)
With Sheets("选型表")
arr = .Range("A2:D3")
For i = 1 To UBound(arr)
dic1(arr(i, 1)) = arr(i, 2)
Next
arr = .Range("A6:C9")
For i = 1 To UBound(arr)
dic2(arr(i, 1)) = arr(i, 2)
Next
arr = .Range("A11:D12")
For i = 1 To UBound(arr)
dic3(arr(i, 1)) = arr(i, 2)
Next
arr = .Range("A15:B17")
For i = 1 To UBound(arr)
dic4(arr(i, 1)) = arr(i, 2)
Next
arr = .Range("A19:D22")
For i = 1 To UBound(arr)
dic5(arr(i, 1)) = arr(i, 2)
Next
arr = .Range("A24:D26")
For i = 1 To UBound(arr)
dic6(arr(i, 1)) = arr(i, 2)
Next
arr = .Range("A28:D29")
For i = 1 To UBound(arr)
dic7(arr(i, 1)) = arr(i, 2)
Next
arr = .Range("A31:D31")
For i = 1 To UBound(arr)
dic8(arr(i, 1)) = arr(i, 2)
Next
End With
arr = sht.UsedRange.Offset(2)
For i = 1 To LastRow - 2
If arr(i, 1) = "" Then brr(i, 1) = "" Else brr(i, 1) = dic1(arr(i, 1))
If arr(i, 2) = "" Then brr(i, 2) = "" Else brr(i, 2) = dic2(arr(i, 2))
If arr(i, 3) = "" Then brr(i, 3) = "" Else brr(i, 3) = dic3(arr(i, 3))
If arr(i, 4) = "" Then brr(i, 4) = "" Else brr(i, 4) = dic4(arr(i, 4))
If arr(i, 5) = "" Then brr(i, 5) = "" Else brr(i, 5) = dic5(arr(i, 5))
If arr(i, 6) = "" Then brr(i, 6) = "" Else brr(i, 6) = dic6(arr(i, 6))
If arr(i, 7) = "" Then brr(i, 7) = "" Else brr(i, 7) = dic7(arr(i, 7))
If arr(i, 8) = "" Then brr(i, 8) = "" Else brr(i, 8) = dic8(arr(i, 8))
Next
sht.Range("J3").Resize(UBound(brr), 8) = brr
End Sub

复制代码

5201314 · 发表于 2012-8-27 18:36

如果解决了就给个最佳吧，毕竟挺费时间的

中世纪书生 · 发表于 2012-8-27 22:26

5201314 发表于 2012-8-27 17:57
那你教我做网站不？

我是仪表技术支持，现在在做网站需要的专业数据，不是网站建设，开发之类的。就是说数据库里的数据，是我们专业的给弄出来，在交给开发人员弄。谢谢你。所以我不会做网站。

tjhjb · 发表于 2012-8-28 09:09

tjhjb · 发表于 2012-8-28 13:24

hyl9td · 发表于 2013-7-19 23:17

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

[已解决]求VBA代码代替VLOOKUP或者用VBA调用VLOOKUP。

评分