遍历指定文件夹多个excel文件，读取文件名和文件中的数据到汇总表

xinlan6

如题
遍历指定文件夹多个excel文件，读取文件名和文件中某几个位置的数据到汇总表
http://club.excelhome.net/thread-599764-1-1.html

hupanshanl老师已经给出了很好的答案
但是，按这个“样式.rar ”，
子表是第一行是小标题（类似数据库的字段名），第二行开始就是数据，
汇总时从第二行开始，小标题才不会重复。
可是
如果原数据的第一行是大标题（表格的名称），第二行为小标题（行标题，类似数据库的字段名），第三行开始才是数据，
汇总时仍然从第二行开始，小标题就会重复。
可否将VBA改为从子表的第三行开始汇总数据？
或者说通过人机对话，由用户选择从子表哪一行开始汇总数据？这将会更实用！
所以，我将需汇总的表格做了点小修改
请大侠帮帮忙，看看如何修改vba。使得汇总时小标题不会重复。
谢谢！

APPLE123

改后更实用，有结果的话，我也要。

opiona

1. Sub Opiona()
   
2. 
   
3. 'On Error Resume Next    '// 发生错误，自动执行下一句，就是忽略错误
   
4. Application.ScreenUpdating = False '//关闭屏幕刷新
   
5. Application.DisplayAlerts = False '//关闭系统提示
   
6. t = Timer   '//开始时间
   
7. 
   
8.     Set SH0 = Sheets("Sheet1")
   
9.     SH0.Range("A2:I65536").ClearContents
   
10.    
    
11.     FileArr = FileAllArr(ThisWorkbook.Path, "*.xls?", ThisWorkbook.Name, True, False)
    
12.     For I = 0 To UBound(FileArr)
    
13.    
    
14.         Str_coon = "HDR=yes';Data Source =" & FileArr(I)    '//OFFICE2003，2007 通用
    
15.         
    
16.         StrSQL = "SELECT '" & GetPathFromFileName(FileArr(I), True) & "' AS  工作簿"   '//不要扩展名，就改为：false
    
17.         StrSQL = StrSQL & ",[编码],[状态],[规格],[接入号],[订单号],[下连端子],[下连端子规格],[下连设备]"
    
18.         StrSQL = StrSQL & " FROM [端子端口详情$A2:H]"
    
19.         IROW = SH0.Range("A65536").End(3).Row + 1
    
20.         SQLARR = GET_SQL_To_Arr(StrSQL, Str_coon, False)
    
21.         SH0.Range("A" & IROW).Resize(UBound(SQLARR, 1) + 1, UBound(SQLARR, 2) + 1) = SQLARR '//（0 TO X)的数组行列都要+1，(1 TO X) 的不要
    
22.     Next I
    
23. 
    
24. Application.ScreenUpdating = True '//恢复屏幕刷新
    
25. Application.DisplayAlerts = True '//恢复系统提示
    
26. MsgBox "一共用时：" & Format(Timer - t, "#0.0000") & " 秒", , "北极狐提示!!"  '//提示所用时间
    
27. End Sub

复制代码

opiona

样式已修改.rar (37.18 KB, 下载次数: 702)

2016-7-15 21:26 上传

点击文件名下载附件

APPLE123

opiona老师！真是神人，点个赞！

xinlan6

opiona 发表于 2016-7-15 21:26

谢谢opiona老师的帮助！

z601520274

opiona 发表于 2016-7-15 21:22

http://club.excelhome.net/thread-1310335-1-1.html 老师帮忙看下

lsc900707

z601520274 发表于 2016-11-6 21:18
http://club.excelhome.net/thread-1310335-1-1.html 老师帮忙看下

If fso.FolderExists(ThisWorkbook.Path & "\" & k) Then
      Set f = fso.GetFolder(ThisWorkbook.Path & "\" & k)
      f.Delete
End If

把这个条件判断句删掉试试！

z601520274

lsc900707 发表于 2016-11-6 21:33
If fso.FolderExists(ThisWorkbook.Path & "\" & k) Then
      Set f = fso.GetFolder(ThisWorkbook.Pa ...

谢谢，可以了

juekasry

opiona 发表于 2016-7-15 21:26

认真学习中，
opiona老师， 有时间帮忙指点一二， 问题提在12楼。谢谢老师
http://club.excelhome.net/thread-1430401-1-1.html