请老师帮忙看一下这种竖转横的查找方法

china047

各位老师:

         如何将附件Sheet1表中C列D列的数据用 字典 的方法, 查找至Sheet2表中对应的B,C,D,E,F及G列中,(查找条件Sheet1的A,B列,Sheet2的A列+对应的B2,C2,D2,E2,F2; G列的"备注复期"也对应查找就可以，先谢过各位老师了. 特殊的查找.rar (98.13 KB, 下载次数: 6)

2021-8-9 16:46 上传

点击文件名下载附件

chxw68

1. Sub test()
   
2.   Dim r%, i%
   
3.   Dim arr, brr
   
4.   Dim d As Object
   
5.   Application.ScreenUpdating = False
   
6.   Application.DisplayAlerts = False
   
7.   Set d1 = CreateObject("scripting.dictionary")
   
8.   Set d2 = CreateObject("scripting.dictionary")
   
9.   With Worksheets("sheet2")
   
10.     .AutoFilterMode = False
    
11.     r = .Cells(.Rows.Count, 1).End(xlUp).Row
    
12.     c = .Cells(2, .Columns.Count).End(xlToLeft).Column
    
13.     .Range("b3").Resize(r - 2, c - 1).ClearContents
    
14.     brr = .Range("a2:g" & r)
    
15.     For i = 2 To UBound(brr)
    
16.       d1(brr(i, 1)) = i
    
17.     Next
    
18.     For j = 2 To UBound(brr, 2) - 1
    
19.       d2(brr(1, j)) = j
    
20.     Next
    
21.   End With
    
22.   With Worksheets("sheet1")
    
23.     .AutoFilterMode = False
    
24.     r = .Cells(.Rows.Count, 1).End(xlUp).Row
    
25.     arr = .Range("a3:d" & r)
    
26.     For i = 1 To UBound(arr)
    
27.       If d1.exists(arr(i, 1)) Then
    
28.         m = d1(arr(i, 1))
    
29.         If d2.exists(arr(i, 2)) Then
    
30.           n = d2(arr(i, 2))
    
31.           brr(m, n) = arr(i, 3)
    
32.         End If
    
33.         brr(m, UBound(brr, 2)) = arr(i, 4)
    
34.       End If
    
35.     Next
    
36.   End With
    
37.   With Worksheets("sheet2")
    
38.     .Range("a2").Resize(UBound(brr), UBound(brr, 2)) = brr
    
39.   End With
    
40. End Sub
    

复制代码

chxw68

详见附件。

china047

chxw68 发表于 2021-8-9 17:26
详见附件。

多谢chxw68老师, 这双字典用得真巧, 运行速度也很快!

china047

chxw68 发表于 2021-8-9 17:26
详见附件。

chxw68老师, 有一点我没弄明白, 为什么表头也跟着一起赋值了,如果表头不用赋值应该怎么改代码?

chxw68

china047 发表于 2021-8-10 08:23
chxw68老师, 有一点我没弄明白, 为什么表头也跟着一起赋值了,如果表头不用赋值应该怎么改代码?

不读取表头怎么定位呢？真的是个奇怪要求。

china047

chxw68 发表于 2021-8-10 08:38
不读取表头怎么定位呢？真的是个奇怪要求。

chxw68老师, 我不是说不读表头, 我是说表头不要重新写入

chxw68

china047 发表于 2021-8-10 08:47
chxw68老师, 我不是说不读表头, 我是说表头不要重新写入

习惯性的做法都是这样，按你说的费时费力没必要。

chxw68

修改好了。

china047

chxw68 发表于 2021-8-10 08:56
修改好了。

多谢chxw68,