如何用VBA查找数据，并填入数据

chenjj007

要求 :1.查找A列中的种类，并将种类填入B列中。
注：每个工作簿种类的列号不一样

chxw68

1. Sub test()
   
2.   Dim r%, i%, c1%, c2%
   
3.   Dim arr, brr
   
4.   Dim d As Object
   
5.   Set d = CreateObject("scripting.dictionary")
   
6.   For Each ws In Worksheets(Array("金属件目录", "标准件目录", "塑料件目录", "组合件目录"))
   
7.     With ws
   
8.       r = .Cells(.Rows.Count, 1).End(xlUp).Row
   
9.       c = .Cells(1, .Columns.Count).End(xlToLeft).Column
   
10.       arr = .Range("a1").Resize(r, c)
    
11.       c1 = 0
    
12.       c2 = 0
    
13.       For j = 1 To UBound(arr, 2)
    
14.         If arr(1, j) = "图号" Then
    
15.           c1 = j
    
16.         ElseIf arr(1, j) = "种类" Then
    
17.           c2 = j
    
18.         End If
    
19.       Next
    
20.       If c1 <> 0 And c2 <> 0 Then
    
21.         For i = 2 To UBound(arr)
    
22.           d(arr(i, c1)) = arr(i, c2)
    
23.         Next
    
24.       End If
    
25.     End With
    
26.   Next
    
27.   With Worksheets("材料明细表")
    
28.     r = .Cells(.Rows.Count, 1).End(xlUp).Row
    
29.     arr = .Range("a2:b" & r)
    
30.     For i = 1 To UBound(arr)
    
31.       If d.exists(arr(i, 1)) Then
    
32.         arr(i, 2) = d(arr(i, 1))
    
33.       End If
    
34.     Next
    
35.     .Range("a2:b" & r) = arr
    
36.   End With
    
37. End Sub
    

复制代码

chxw68

详见附件。

chenjj007

chxw68 发表于 2022-2-19 11:13
详见附件。

谢谢大佬！！！

feilanga

翻译学习大佬的代码

1. Sub test() '分表列不固定字典单关键字查找
   
2.     Dim r%, i%, c1%, c2%
   
3.     Dim arr, brr
   
4.     Dim d As Object
   
5.     Set d = CreateObject("scripting.dictionary")
   
6.     'For Each sh In Worksheets(Array("金属件目录", "标准件目录", "塑料件目录", "组合件目录"))
   
7.     For Each sh In Worksheets '遍历所有工作表
   
8.         If sh.Name <> "材料明细表" Then
   
9.             irow = sh.Cells(sh.Rows.Count, 1).End(xlUp).Row '分表最大行
   
10.             col = sh.Cells(1, sh.Columns.Count).End(xlToLeft).Column '分表最大列
    
11.             arr = sh.Range("a1").Resize(irow, col) '分表数据装入数组
    
12.             c1 = 0
    
13.             c2 = 0
    
14.             For j = 1 To UBound(arr, 2) '从分表的第1列循环到最大列
    
15.                 If arr(1, j) = "图号" Then '在表头字段中定位"图号"的列号
    
16.                     c1 = j
    
17.                 ElseIf arr(1, j) = "种类" Then '在表头字段中定位"种类"的列号
    
18.                     c2 = j
    
19.                 End If
    
20.             Next
    
21.             If c1 <> 0 And c2 <> 0 Then '如果已经定位了图号和种类的列号
    
22.                 For i = 2 To UBound(arr) '循环分表的有效数据区
    
23.                     Key = arr(i, c1) '关键字=图号
    
24.                     d(Key) = arr(i, c2) '图号存入字典keys 种类存入字典items
    
25.                 Next
    
26.             End If
    
27.         End If
    
28.     Next
    
29.     irow = Sheet101.Cells(Sheet101.Rows.Count, 1).End(xlUp).Row '查询表A列最大行
    
30.     brr = Sheet101.Range("a2:b" & irow) '查询区装入数组
    
31.     For i = 1 To UBound(brr) '循环查询区
    
32.         Key = brr(i, 1) '关键字=图号
    
33.         If d.exists(Key) Then '如果字典中存在相同关键字,则把关键字对应的值从字典中取出
    
34.             brr(i, 2) = d(Key) '存入结果数组第2列
    
35.         End If
    
36.     Next
    
37.     Sheet101.Range("a2:b" & irow) = brr '结果数组输出结果到单元格
    
38. End Sub

复制代码

YYKK001

chxw68 发表于 2022-2-19 11:13
详见附件。

老师 您好，数据查询和写入 能否帮忙看下怎么做比较好谢谢