关于dic中匹配取值的问题

暴走的小兔牙

工作簿中sheet1中，匹配sheet2后，取sheet2中对应的值。

如果在sheet1中是连续的单元格，如C、D可以使用resize来实现。
如果在sheet1中不是连续的单元格，如C、E，那这个时候怎么获取呢？

Peny2020

改成这样，用A列的去匹配。


Sub test()
Dim i1, i2 As Variant
Dim dic As Object
Dim arr, brr
Dim wb1, wb2 As Workbook
Dim twb As String
twb = ThisWorkbook.Name
Set wb1 = Workbooks(twb)

wb1.Activate
Set dic = CreateObject("scripting.dictionary")
wb1.Sheets(1).Select

arr = wb1.Sheets(2).Range("a1:d" & Range("a65536").End(3).Row)
brr = wb1.Sheets(1).Range("a10:e" & Range("a65536").End(3).Row)
For i1 = 1 To UBound(arr)
    dic(arr(i1, 1)) = Array(arr(i1, 2), arr(i1, 4))
Next i1

For i = 1 To UBound(brr)
If dic.exists(brr(i, 1)) Then
brr(i, 3) = dic(brr(i, 1))(0)
brr(i, 5) = dic(brr(i, 1))(1)
Else
brr(i, 3) = ""
brr(i, 5) = ""
End If
Next

wb1.Sheets(1).Range("a10:e" & Range("a65536").End(3).Row) = brr

Set dic = Nothing

Peny2020

改成这样，用A列的去匹配。


Sub test()
Dim i1, i2 As Variant
Dim dic As Object
Dim arr, brr
Dim wb1, wb2 As Workbook
Dim twb As String
twb = ThisWorkbook.Name
Set wb1 = Workbooks(twb)

wb1.Activate
Set dic = CreateObject("scripting.dictionary")
wb1.Sheets(1).Select

arr = wb1.Sheets(2).Range("a1:d" & Range("a65536").End(3).Row)
brr = wb1.Sheets(1).Range("a10:e" & Range("a65536").End(3).Row)
For i1 = 1 To UBound(arr)
    dic(arr(i1, 1)) = Array(arr(i1, 2), arr(i1, 4))
Next i1

For i = 1 To UBound(brr)
If dic.exists(brr(i, 1)) Then
brr(i, 3) = dic(brr(i, 1))(0)
brr(i, 5) = dic(brr(i, 1))(1)
Else
brr(i, 3) = ""
brr(i, 5) = ""
End If
Next

wb1.Sheets(1).Range("a10:e" & Range("a65536").End(3).Row) = brr

Set dic = Nothing

Peny2020

附件这样。

无关岁月

副本TEST.7z (18.42 KB, 下载次数: 5)

2024-3-28 12:01 上传

点击文件名下载附件

ykcbf1100

论坛又崩了。。。

1. Sub ykcbf()   '//2024.3.28
   
2.     Dim arr, d
   
3.     Application.ScreenUpdating = False
   
4.     Set d = CreateObject("Scripting.Dictionary")
   
5.     With Sheets("Sheet1")
   
6.         r = .Cells(.Rows.Count, "a").End(xlUp).Row
   
7.         arr = .[a1].Resize(r, 5)
   
8.     End With
   
9.     For i = 2 To UBound(arr)
   
10.         s = arr(i, 1)
    
11.         If arr(i, 3) <> Empty Then
    
12.             d(s) = Array(arr(i, 3), arr(i, 5))
    
13.         End If
    
14.     Next
    
15.     With Sheets("Sheet2")
    
16.         r = .Cells(.Rows.Count, "a").End(xlUp).Row
    
17.         arr = .[a1].Resize(r, 3)
    
18.         For i = 1 To UBound(arr)
    
19.             s = arr(i, 1)
    
20.             If d.Exists(s) Then
    
21.                 arr(i, 2) = d(s)(0)
    
22.                 arr(i, 3) = d(s)(1)
    
23.             End If
    
24.         Next
    
25.         .[a1].Resize(r, 3) = arr
    
26.     End With
    
27.     Set d = Nothing
    
28.     Application.ScreenUpdating = True
    
29.     MsgBox "OK！"
    
30. End Sub
    
31. 
    

复制代码