求教！同目录下提取同一SHEET中的非空行到一个文件中

ClarkQu109

求教各位大神！先谢过！！
同一文件夹下有很多名字如XXX001.xlsx、XXX002.xlsx、XXX003.xlsx......的文件，
现在想从每个文件的sheet1中提取A3行以下，所有非空行（数据是连贯的，中间没有空行，只不过有的文件中，sheet1 A3行以下有连续的2行数据，有的文件是1行或3行），汇总到同一目录的“汇总.xlsx”的“总”sheet中。
希望能不用打开每个文件，并且优化遍历速度，因为文件很多，谢谢各位大神！！！感谢！感谢！！！！！

liulang0808

http://club.excelhome.net/thread-1258425-1-1.html
遍历文件的资料，楼主可以参考下

ClarkQu109

liulang0808 发表于 2018-7-10 13:31
http://club.excelhome.net/thread-1258425-1-1.html
遍历文件的资料，楼主可以参考下

一早就看过了，研究了大半天，还是没能做出想要的结果~~~~

ClarkQu109

求大神帮助啊~~~~！！！！！

美好未来686

用SQL和ADO

ClarkQu109

美好未来686 发表于 2018-7-10 14:32
用SQL和ADO

能具体一点吗，我新人小白~~~~不好意思啊~~~~

liulang0808

1. Sub test1()
   
2.     Set fso = CreateObject("scripting.filesystemobject")
   
3.     Application.ScreenUpdating = False
   
4.     Set sh = ActiveSheet
   
5.     sh.UsedRange.Clear
   
6.     a = 1
   
7.     For Each f In fso.getfolder(ThisWorkbook.Path).Files
   
8.         If InStr(f.Name, "汇总") = 0 Then
   
9.             With Workbooks.Open(f)
   
10.                 .Sheets(1).UsedRange.Offset(3).Copy sh.Cells(a, 1)
    
11.                 a = sh.Cells(Rows.Count, 1).End(3).Offset(1).Row
    
12.                 .Close False
    
13.             End With
    
14.         End If
    
15.     Next f
    
16.     Application.ScreenUpdating = True
    
17. End Sub
    

复制代码

liulang0808

附件内容供参考。。。。。。

美好未来686

这个要先有基本功了，才能学SQL和ADO，就可以做到不打工作簿读取数据，只要数据文件都在一个文件夹就行了，这不是一两天可以做到的，你慢慢学吧！写起来也麻烦，我也只是会点，但不精，关键是我平时用不着就每去深究！

美好未来686

还有一种引用的方法，不过不知道快不快！
Rem VBA知识点：Path
Option Explicit
'声明一个带有四个参数的Sub过程
Sub 取值(路径 As String, 文件 As String, 工作表, 单元格 As String)
On Error Resume Next
Dim rng As Range, arr()
Set rng = ActiveCell.Resize(Range(单元格).Rows.Count, Range(单元格).Columns.Count)
    If Err <> 0 Then
    MsgBox "请调整区域,当前区域不足以存放引用区域的值" _
    & Chr(10) & "建议选择A1再执行程序", 64, "提示"
    Exit Sub
    End If
    '将目标区域复制到以当前表活动单元格为左上角的相同大小的区域中
  With Range("a1").Resize(Range(单元格).Rows.Count, Range(单元格).Columns.Count)  'range("a1")是需要存放的位置
    '在指定区域输入公式，该公式引用指定路径下的工作表数据，可以是单元格也可以是区域
    .FormulaArray = "='" & 路径 & "\[" & 文件 & "]" & 工作表 & "'!" & 单元格
    '将公式转换成值
    .Value = .Value
  End With
End Sub
Sub 不打开工作簿而获取其值1()
    '调用Sub过程,指定参数
  取值 ThisWorkbook.Path & "\人事资料", "人事报表.xls", "部门人员统计", "A1:B9"
End Sub
Sub 不打开工作簿而获取其值2()
Dim arr()
    '调用Sub过程,指定参数
  取值 ThisWorkbook.Path & "\人事资料", "人事报表.xls", "人事资料", "A1:C42"
End Sub