VBA，实现VLOOKUP一样的功能

Authority1000

各位老师，帮忙看下：
在产品信息中，输入型号，
然后一键就能将后面的字段相关信息带出来
其中，有些行的信息已经存在，就略过
将其他空白的填充即可

虽然VLOOKUP功能很好实现，但是，考虑到这个表格可能在使用过程中，公式会被破坏

请老师帮忙看下
求助.zip (106.78 KB, 下载次数: 19)

2024-5-11 11:55 上传

点击文件名下载附件

我自己尝试编了一个很粗糙的，但是我是新手小白，
只能实现把产品名称带过来，其他的，我就不会了，
而且，还不能实现判断是否是空的


Sub 测试()

    Dim d As Object, kw$
    Set d = CreateObject("scripting.dictionary")
    Dim ar, br
   
    ar = Sheet2.[B2:F100]
    br = Sheet1.[B3:F100]
   
    Dim i, j
   
    For i = 1 To UBound(ar)
        d(ar(i, 1)) = ar(i, 2)
    Next i
        
        
    For j = 1 To UBound(br)
        br(j, 2) = d(br(j, 1))
    Next j
   
        
   
    Sheet1.[B3:F100] = br
   
End Sub

蓝桥玄霜

报价单的例子：

Qs18

Sub test()
Sheet1.Activate
Dim arr, dic As Object, r As Range, rng As Range
Set dic = CreateObject("scripting.dictionary")
ReDim brr(1 To 4)
arr = Sheet2.UsedRange
For i = 1 To UBound(arr)
    dic(arr(i, 1)) = arr(i, 2) & "#" & arr(i, 3) & "#" & arr(i, 4) & "#" & arr(i, 5)
Next
Set rng = Range("c3:c16")
For Each r In rng
    If r.Value = "" Then
        r.Resize(1, 4) = Split(dic(r.Offset(0, -1).Value), "#")
    End If
Next
Range("f3:f16").Value = Range("f3:f16").Value
MsgBox "执行完毕！"
End Sub

lln0618

直接从第一行 全部填充就好  

Authority1000

蓝桥玄霜 发表于 2024-5-11 12:21
报价单的例子：

谢谢老师！！！

Authority1000

Qs18 发表于 2024-5-11 13:51
Sub test()
Sheet1.Activate
Dim arr, dic As Object, r As Range, rng As Range

谢谢老师！

blackttea1

学习啦 ，谢谢

yanglinzi

1. Sub 查询()
   
2. Dim arr, i, j, r, d
   
3. Set d = CreateObject("scripting.dictionary")
   
4. With Sheet2
   
5.     r = .Cells(Rows.Count, 2).End(xlUp).Row
   
6.     arr = .Range("b2:f" & r)
   
7. End With
   
8. For i = 2 To UBound(arr)
   
9.     sa = arr(i, 1)
   
10.     d(sa) = i
    
11. Next
    
12. With Sheet1
    
13.     For j = 3 To .Cells(Rows.Count, 2).End(xlUp).Row
    
14.         sb = .Cells(j, 2).Value
    
15.         n = d(sb)
    
16.         If .Cells(j, 3) = "" Then
    
17.             If d.exists(sb) Then
    
18.                 For i = 3 To 6
    
19.                     .Cells(j, i) = arr(n, i - 1)
    
20.                 Next
    
21.             End If
    
22.         End If
    
23.     Next
    
24. End With
    
25. End Sub
    

复制代码

yanglinzi

查询。。。