双条件查找返回求老师帮忙

yysfcq1

双条件查找返回求老师帮忙

小凡、、、

用代码实现函数结果这样的效果？

yysfcq1

小凡、、、 发表于 2024-8-7 20:38
用代码实现函数结果这样的效果？

是的老师我想用代码实现

ykcbf1100

附件中那么多代码是你自己写的吗？

这个是字典中最简单的，按理应该会啊。

ykcbf1100

参与一下。。。

1. Sub ykcbf()   '//2024.8.7   字典
   
2.     Dim arr, brr, d
   
3.     Application.ScreenUpdating = False
   
4.     Set d = CreateObject("scripting.dictionary")
   
5.     arr = Sheets("物料清单").UsedRange
   
6.     For i = 2 To UBound(arr)
   
7.         s = arr(i, 1) & "|" & arr(i, 2)
   
8.         d(s) = arr(i, 5)
   
9.     Next
   
10.     With Sheets("总档")
    
11.         r = .Cells(Rows.count, 1).End(3).Row
    
12.         For i = 3 To r
    
13.             s = .Cells(i, 1) & "|" & .Cells(i, 2)
    
14.             If d.exists(s) Then
    
15.                 .Cells(i, 5) = d(s)
    
16.             End If
    
17.         Next
    
18.     End With
    
19.     Set d = Nothing
    
20.     Application.ScreenUpdating = True
    
21.     MsgBox "OK！"
    
22. End Sub
    

复制代码

yysfcq1

ykcbf1100 发表于 2024-8-7 20:49
附件中那么多代码是你自己写的吗？

这个是字典中最简单的，按理应该会啊。

谢谢老师我小白一个

无关岁月

Sub 按钮1_Click()
Dim d, arr, brr, i, j, s
Set d = CreateObject("scripting.dictionary")
arr = Sheet1.[a2].CurrentRegion
For i = 2 To UBound(arr)
    d(arr(i, 1) & arr(i, 2)) = i
Next
brr = Sheet4.[a1].CurrentRegion
For i = 2 To UBound(brr)
    s = brr(i, 1) & brr(i, 2)
    If Len(d(s)) Then
        j = d(s)
        arr(j, 5) = brr(i, 5)
    Else
        arr(j, 5) = ""
    End If
Next
Sheet1.[a2].CurrentRegion = arr
End Sub

cai2532

查询实例学习了。

zhangcheng6688

学习一下字典，打扰了
Sub test()
arr = Sheets("物料清单").[a1].CurrentRegion
Set d = CreateObject("scripting.dictionary")
For i = 2 To UBound(arr)
   s = arr(i, 1) & arr(i, 2)
   d(s) = i
Next
Brr = Sheets("总档").[a2].CurrentRegion
For i = 2 To UBound(Brr)
   s = Brr(i, 1) & Brr(i, 2)
   If d.exists(s) Then
      Brr(i, 5) = arr(d(s), 5)
   Else
      Brr(i, 5) = ""
   End If
Next
[a2].CurrentRegion = Brr
End Sub