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

lsc900707

jjmysjg 发表于 2018-7-14 10:12
谢谢，B66是合并单元格，为啥改了你的几句，就可以了？

取消合并单元格就好了。

dagal

lsc900707 发表于 2018-7-14 07:36
Sub gj23w98()
    Dim arr()
    Application.ScreenUpdating = False

能否在最后一列再自动生成所有列的合计数，而且第8行的营业毛利率=第7行营业毛利/第5行营业收入所得，格式为百分比。

lsc900707

dagal 发表于 2018-7-14 10:35
能否在最后一列再自动生成所有列的合计数，而且第8行的营业毛利率=第7行营业毛利/第5行营业收入所得，格 ...

你的数据有的错误会导致计算出错，你自己用函数拉一下吧。
公式错误的话你修改数据源才可以。

dagal

lsc900707 发表于 2018-7-14 10:42
你的数据有的错误会导致计算出错，你自己用函数拉一下吧。
公式错误的话你修改数据源才可以。

嗯。我看看源数据。师傅，能否改为是文件夹下的字文件夹内，因为每月各部门上报的报表时这些文件是在文件夹下的子文件夹内，之前是为了测试，我给复制了出来，如果日常工作时，要单独再去复制文件较为繁琐，谢谢了~~~

lsc900707

dagal 发表于 2018-7-14 11:47
嗯。我看看源数据。师傅，能否改为是文件夹下的字文件夹内，因为每月各部门上报的报表时这些文件是在文件 ...

你复制汇总工作簿到对应的文件夹里去不就好了。

t502435282

lsc900707 发表于 2018-7-14 07:36
Sub gj23w98()
    Dim arr()
    Application.ScreenUpdating = False

怎么加入 选择文件夹 代码

With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "请选择需汇总的文件夹"
        .Show
        If .SelectedItems.Count = 0 Then
            Exit Sub
        Else
            mypath = .SelectedItems(1) & "\"
        End If
    End With

lsc900707

t502435282 发表于 2018-7-14 15:33
怎么加入 选择文件夹 代码

With Application.FileDialog(msoFileDialogFolderPicker)

Sub gj23w98()
    Dim arr()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Sheet1.Range("c4:r" & 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, vbDirectory)
    Do While f <> ""
        If f <> "." And f <> ".." Then
            If (GetAttr(p & f) And vbDirectory) = vbDirectory Then
                m = m + 1
                ReDim Preserve arr(m)
                arr(m) = p & f & "\"
            End If
        End If
        f = Dir
    Loop
    For j = 1 To m
        f = Dir(arr(j) & "*.xls")
        While f <> ""
            Set wb = CreateObject(arr(j) & f)
            With wb.Sheets(1)
                 ar = .[c5:c65]
            End With
            Sheet1.Cells(5, 3 + n).Resize(61) = ar
            Sheet1.Cells(4, 3 + n) = Replace(Split(Split(f, ".")(0), "-")(1), "表", "")
            n = n + 1
            wb.Close False
            f = Dir()
        Wend
    Next
    Set wb = Nothing
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub

t502435282

lsc900707 发表于 2018-7-17 09:00
Sub gj23w98()
    Dim arr()
    Application.ScreenUpdating = False

比如我选择汇总的路径是E:\桌面\1测试     结果汇总的路径是E:\桌面\1测试\新建文件夹
这个怎么修改代码啊

lsc900707

t502435282 发表于 2018-7-17 09:11
比如我选择汇总的路径是E:\桌面\1测试     结果汇总的路径是E:\桌面\1测试\新建文件夹
这个怎么修改代码 ...

1测试是个文件夹，下面又有个新建文件夹？
你把附件的文件夹和汇总工作簿拆放开测试看看。

t502435282

测试了  我选择汇总的路径是E:\桌面\1测试     结果汇总的路径是E:\桌面\1测试\新建文件夹
我想汇总的是E:\桌面\1测试 里面的数据 不要E:\桌面\1测试\新建文件夹 里面的数据