求租提取所有文件夹中同一列数据生成一张汇总报表

t502435282

lsc900707 发表于 2018-7-17 09:32
1测试是个文件夹，下面又有个新建文件夹？
你把附件的文件夹和汇总工作簿拆放开测试看看。

1测试是个文件夹，下面又有个新建文件夹？

1测试 下面的新建文件夹是测试用的   如果1测试文件夹下面没有文件夹 就什么也汇总不到

t502435282

lsc900707 发表于 2018-7-17 09:32
1测试是个文件夹，下面又有个新建文件夹？
你把附件的文件夹和汇总工作簿拆放开测试看看。

我上传了实例文件  你把汇总工作簿和工程分开放测试下能汇总数据吗

我测试了好几次都是总不到  

lsc900707

t502435282 发表于 2018-7-17 09:51
我上传了实例文件  你把汇总工作簿和工程分开放测试下能汇总数据吗

我测试了好几次都是总不到

看了附件，两点建议：
1.这个代码是汇总一个文件夹下面有多个子文件夹的代码。
2.不要用低版本的office去汇总高版本的office文件。

lsc900707

t502435282 发表于 2018-7-17 09:51
我上传了实例文件  你把汇总工作簿和工程分开放测试下能汇总数据吗

我测试了好几次都是总不到

自己在分开放置测试看看：

lsc900707

t502435282 发表于 2018-7-17 09:51
我上传了实例文件  你把汇总工作簿和工程分开放测试下能汇总数据吗

我测试了好几次都是总不到

如果你是一个文件夹多个工作簿，代码更简单。

t502435282

lsc900707 发表于 2018-7-17 10:37
如果你是一个文件夹多个工作簿，代码更简单。

我想要的代码就是一个文件夹多个工作簿  表达能力不强 请见谅

dagal

谢谢，测试了，可以。。比原来方便

lsc900707

t502435282 发表于 2018-7-17 10:46
我想要的代码就是一个文件夹多个工作簿  表达能力不强 请见谅

Sub 录入表汇总()
    Dim arr()
      If MsgBox("是否确定汇总数据？", vbYesNo + vbInformation) = vbNo Then Exit Sub
    Application.ScreenUpdating = False '//关闭屏幕刷新
    Application.DisplayAlerts = False '//关闭系统提示
     t = Timer   '//开始时间
    Sheet1.Range("e2:ca" & Rows.Count).ClearContents
    With Application.FileDialog(msoFileDialogFolderPicker)
         .Title = "请选择需汇总的文件夹"
         .Show
         If .SelectedItems.Count = 0 Then
             Exit Sub
         Else
             p = .SelectedItems(1) & "\"
         End If
    End With
    f = Dir(p & "*.xls*")
    Do While f <> ""
        Set wb = CreateObject(p & f)
        With wb.Sheets("录入表")
            ar = .[i3:i309]
        End With
        Sheet1.Cells(3, 5 + n).Resize(61) = ar
        Sheet1.Cells(2, 5 + n) = Replace(Split(Split(f, ".")(0))(0), "FTTH", "")
        n = n + 1
        wb.Close False
        f = Dir()
    Loop
    Set wb = Nothing
    Application.ScreenUpdating = True '//恢复屏幕刷新
    Application.DisplayAlerts = True '//恢复系统提示
     MsgBox "一共用时：" & Format(Timer - t, "#0.0000") & " 秒共汇总了  " & n & "  个文件"
End Sub

lsc900707

t502435282 发表于 2018-7-17 10:46
我想要的代码就是一个文件夹多个工作簿  表达能力不强 请见谅

代码需要审核，先传回附件。

t502435282

lsc900707 发表于 2018-7-17 11:01
Sub 录入表汇总()
    Dim arr()
      If MsgBox("是否确定汇总数据？", vbYesNo + vbInformation) =  ...

非常感谢  就是我想要的