多条件查询

ャ涣熊ヅ

根据名称和班级 实现多条件 查询   显示每行的数据   

ykcbf1100

附件供参考。。。

ykcbf1100

参与一下。。。

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

复制代码

ャ涣熊ヅ

ykcbf1100 发表于 2024-4-14 19:53
附件供参考。。。

谢谢 老师的指导

feilanga

1. ' 定义一个名为ykcbf的子过程，用于合并两个工作表的数据并根据指定条件填充到Sheet1
   
2. '
   
3. ' 实现原理：
   
4. ' 1. 创建一个字典d，用于存储数据表（数据）中两列拼接后的唯一键及其对应的行号
   
5. ' 2. 获取数据表（数据）的最后一行
   
6. ' 3. 将数据表的第一列和第二列拼接，作为键，存储到数组arr中，并更新字典d
   
7. ' 4. 遍历brr（Sheet1的待处理数据），如果键存在于字典d中，则将对应的数据填充到Sheet1的相应位置
   
8. ' 5. 将处理后的brr赋值给Sheet1的[a1]区域
   
9. ' 6. 清理内存，释放字典对象，恢复屏幕更新，并显示消息框确认操作完成
   
10. Sub ykcbf()
    
11.     ' 创建一个字典对象d，用于存储键值对
    
12.     Dim arr, d
    
13.     ' 禁用屏幕更新以提高性能
    
14.     Application.ScreenUpdating = False
    
15.     ' 创建字典d
    
16.     Set d = CreateObject("Scripting.Dictionary")
    
17.     ' 选择数据表（数据）的工作表
    
18.     With Sheets("数据")
    
19.         ' 获取最后一行的行号
    
20.         r = .Cells(.Rows.Count, "a").End(xlUp).Row
    
21.         ' 将数据表的前六列（包括标题）复制到数组arr
    
22.         arr = .[a1].Resize(r, 6)
    
23.     End With
    
24.     ' 遍历arr，将第一列和第二列拼接为键，值为行号
    
25.     For i = 2 To UBound(arr)
    
26.         s = arr(i, 1) & arr(i, 2)
    
27.         d(s) = i
    
28.     Next
    
29.     ' 选择Sheet1
    
30.     With Sheets("Sheet1")
    
31.         ' 获取最后一行的行号
    
32.         r = .Cells(.Rows.Count, "a").End(xlUp).Row
    
33.         ' 将Sheet1的前六列（包括标题）复制到数组brr
    
34.         brr = .[a1].Resize(r, 6)
    
35.         ' 遍历brr，如果键存在字典d中，将对应arr的数据填充到brr
    
36.         For i = 2 To UBound(brr)
    
37.             s = brr(i, 1) & brr(i, 2)
    
38.             If d.Exists(s) Then
    
39.                 ' 从arr中获取匹配行的数据填充到brr
    
40.                 For j = 3 To UBound(arr, 2)
    
41.                     brr(i, j) = arr(d(s), j)
    
42.                 Next
    
43.             End If
    
44.         Next
    
45.         ' 将处理后的brr覆盖到Sheet1的[a1]区域
    
46.         .[a1].Resize(r, 6) = brr
    
47.     End With
    
48.     ' 释放字典对象，恢复屏幕更新
    
49.     Set d = Nothing
    
50.     Application.ScreenUpdating = True
    
51.     ' 显示消息框确认操作完成
    
52.     MsgBox "OK！"
    
53. End Sub

复制代码

shiruiqiang

ykcbf1100

feilanga 发表于 2024-4-18 09:35

注释很到位，点赞！

dgseg

注释很到位，点赞！

忆往昔今

注释很到位，点赞！

YANWEI82123300

shiruiqiang 发表于 2024-4-18 13:11

shiruiqiang ,我刚刚抄写您提供的代码报错:strConn= "prvoider= microsoft.jet.OLEDB.12.0;extended properties = excel 12.0;data source"
您看看是什么原因?谢谢