用VBA SQL统计筛选文件夹下多个文档的数据

zhaogang1960

下面附件中字段名为a、b
数据汇总.rar (30.13 KB, 下载次数: 76)

2011-4-6 15:57 上传

点击文件名下载附件

hhaa999

学习，谢谢了

jqg1959

认真学习，虚心学习。

LMY123

SQL多薄单表合并

补充内容 (2018-9-30 11:49):
For Each MyTable In cat.Tables

gaoyong0713

zhaogang1960 发表于 2011-4-6 11:40

这个好东西，需要下来学习

ykcbf1100

纯练手，fso+数组

ykcbf1100

练手而已。。。

1. Sub ykcbf()  '//2024.4.8  纯练手,fso+数组
   
2.     Set fso = CreateObject("scripting.filesystemobject")
   
3.     Application.ScreenUpdating = False
   
4.     Set sh = ThisWorkbook.Sheets("12-1")
   
5.     p = ThisWorkbook.Path & "\Dd-0"
   
6.     ReDim brr(1 To 10000, 1 To 2)
   
7.     For Each f In fso.GetFolder(p).Files
   
8.         If f.Name Like "*.xls*" Then
   
9.             If InStr(f.Name, ThisWorkbook.Name) = 0 Then
   
10.                 fn = fso.GetBaseName(f)
    
11.                 Set wb = Workbooks.Open(f, 0)
    
12.                 With wb.Sheets(1)
    
13.                     r = .Cells(Rows.Count, 1).End(3).Row
    
14.                     arr = .[a1].Resize(r, 2)
    
15.                     wb.Close False
    
16.                 End With
    
17.                 For i = 2 To UBound(arr)
    
18.                     If arr(i, 2) >= 100 Then
    
19.                         m = m + 1
    
20.                         For j = 1 To UBound(arr, 2)
    
21.                             brr(m, j) = arr(i, j)
    
22.                         Next
    
23.                     End If
    
24.                 Next
    
25.             End If
    
26.         End If
    
27.     Next f
    
28.     On Error Resume Next
    
29.     With sh
    
30.       .[a2:b10000] = ""
    
31.       .[a2].Resize(m, 2) = brr
    
32.     End With
    
33.     Application.ScreenUpdating = True
    
34.     MsgBox "OK！"
    
35. End Sub
    

复制代码

baofa2