如何利用VBA批量查询并复制

桥边折柳赠佳人

如附件.每次在Sheet'出库查询'B2单元格输入单号会数据库导出一行数据，现在目标Sheet“扫码区”A列有N个单号，如何根据第一行条件如“数量”“重量”将A列数据从出库查询中复制到目标对应单元格后面。。。求大佬指点！

liulang0808

建议楼主再结合附件内容，具体描述下是在哪张表的哪个位置输入重量级数量
并模拟出对应结果，便于大家理解处理的

3190496160

看半天，还是一头雾水，说明需求，一定要准确描述自己的需求的逻辑关系，特别是单元格地址，

桥边折柳赠佳人

liulang0808 发表于 2024-7-28 05:47
建议楼主再结合附件内容，具体描述下是在哪张表的哪个位置输入重量级数量
并模拟出对应结果，便于大家理解 ...

公司的表格带锁我无法复制出来

ykcbf1100

我猜楼主是这个意思吧。

ykcbf1100

参与一下。。。

1. Sub ykcbf()   '//2024.7.29
   
2.     Application.ScreenUpdating = False
   
3.     Set d = CreateObject("Scripting.Dictionary")
   
4.     With Sheets("出库查询")
   
5.         r = .Cells(Rows.Count, 3).End(3).Row
   
6.         zrr = .[a1].Resize(r, 7)
   
7.         For i = 3 To UBound(zrr)
   
8.             s = zrr(i, 2)
   
9.             d(s) = i
   
10.         Next
    
11.     End With
    
12.     With Sheets("扫码区")
    
13.         r = .Cells(Rows.Count, 1).End(3).Row
    
14.         arr = .[a1].Resize(r, 3)
    
15.         For i = 2 To UBound(arr)
    
16.             s = arr(i, 1)
    
17.             If d.exists(s) Then
    
18.                 arr(i, 2) = zrr(d(s), 3)
    
19.                 arr(i, 3) = zrr(d(s), 4)
    
20.             End If
    
21.         Next
    
22.         .[a1].Resize(r, 3) = arr
    
23.     End With
    
24.     Set d = Nothing
    
25.     Application.ScreenUpdating = False
    
26.     MsgBox "OK！"
    
27. End Sub
    
28. 
    

复制代码

桥边折柳赠佳人

ykcbf1100 发表于 2024-7-29 08:01
参与一下。。。

大佬你看看我的新主题，里面你看能根据改改吗

ykcbf1100

桥边折柳赠佳人 发表于 2024-8-7 21:55
大佬你看看我的新主题，里面你看能根据改改吗

猜一下，是这意思？

ykcbf1100

猜一下。。。

1. Sub ykcbf()   '//2024.8.8
   
2.     Application.ScreenUpdating = False
   
3.     Set d = CreateObject("Scripting.Dictionary")
   
4.     With Sheets("出库查询")
   
5.         s = .Cells(3, 2)
   
6.         d(s) = .Cells(3, 3)
   
7.     End With
   
8.     With Sheets("扫码区")
   
9.         r = .Cells(Rows.Count, 1).End(3).Row
   
10.         arr = .[a1].Resize(r, 2)
    
11.         For i = 2 To UBound(arr)
    
12.             s = arr(i, 1)
    
13.             If d.exists(s) Then
    
14.                 arr(i, 2) = d(s)
    
15.             End If
    
16.         Next
    
17.         .[b1].Resize(r, 1) = Application.Index(arr, 0, 2)
    
18.     End With
    
19.     Set d = Nothing
    
20.     Application.ScreenUpdating = False
    
21.     MsgBox "OK！"
    
22. End Sub
    

复制代码

心的启点

桥边折柳赠佳人 发表于 2024-7-28 13:18
公司的表格带锁我无法复制出来

那你就自己做个模拟表出来