老师帮忙修改代码

天真无鞋

1.打开工作簿，在B5单元格输入信息，通过局域网查找2个表格信息，如果相符需把数据全部复制过来，但是有一个工作表的数据无法复制过来，详见附加文件。

ykcbf1100

改代码太费时间，我还是新写一个吧。

ykcbf1100

多工作簿单条件合并。

1. Sub ykcbf()   '//2024.7.12
   
2.     Set fso = CreateObject("scripting.filesystemobject")
   
3.     Set d = CreateObject("Scripting.Dictionary")
   
4.     Application.ScreenUpdating = False
   
5.     Set sh = ThisWorkbook.Sheets("数据")
   
6.     With sh
   
7.         st = CStr(.[b5].Value)
   
8.         For j = 1 To 6
   
9.             d(.Cells(11, j).Value) = j
   
10.         Next
    
11.     End With
    
12.     ReDim brr(1 To 10000, 1 To 6)
    
13.     p = ThisWorkbook.Path & "\数据"
    
14.     On Error Resume Next
    
15.     For Each f In fso.GetFolder(p).Files
    
16.         If LCase$(f.Name) Like "*.xls*" Then
    
17.             Set wb = Workbooks.Open(f, 0)
    
18.             With wb.Sheets(1)
    
19.                 .AutoFilterMode = False
    
20.                 arr = .UsedRange
    
21.                 wb.Close False
    
22.             End With
    
23.             For i = 4 To UBound(arr)
    
24.                 If CStr(arr(i, 2)) = st Then
    
25.                     m = m + 1
    
26.                     For j = 1 To UBound(arr, 2)
    
27.                         s = arr(1, j)
    
28.                         brr(m, d(s)) = arr(i, j)
    
29.                     Next
    
30.                 End If
    
31.             Next
    
32.         End If
    
33.     Next f
    
34.     With sh
    
35.         .[a12:f10000] = ""
    
36.         .[a12].Resize(m, 6) = brr
    
37.     End With
    
38.     Set d = Nothing
    
39.     Application.ScreenUpdating = True
    
40.     MsgBox "OK！"
    
41. End Sub
    
42. 
    

复制代码

GDVBXX

第二个循环引用的变量不对，应该全部改成j

天真无鞋

GDVBXX 发表于 2024-7-12 13:27
第二个循环引用的变量不对，应该全部改成j

谢谢老师

天真无鞋

ykcbf1100 发表于 2024-7-12 13:17
改代码太费时间，我还是新写一个吧。

谢谢老师

ykcbf1100

天真无鞋 发表于 2024-7-12 13:47
谢谢老师

说实话，你直接对单元格操作，不仅速度慢，而且代码冗长且不容易维护，不是好办法。

天真无鞋

ykcbf1100 发表于 2024-7-12 13:51
说实话，你直接对单元格操作，不仅速度慢，而且代码冗长且不容易维护，不是好办法。

才逐步走向VBA其他不会，主要是想同过EXCEL工作表放任何位置都可以通过，局域网获取信息