如何复制每个分表中的一列数据到汇总表，并对数据进行汇总

liurongyue

之前想根据老师代码修改再用，但能力有限修改不了。请老师再帮我改改、非常感谢！

zax010

liurongyue 发表于 2014-11-22 11:21
之前想根据老师代码修改再用，但能力有限修改不了。请老师再帮我改改、非常感谢！

新附件和原附件的格式差距太大。请说明要复制分表的哪些数据》

liurongyue

需要复制每个表的E列和J列并汇总

zax010

liurongyue 发表于 2014-11-22 13:55
需要复制每个表的E列和J列并汇总

Sub zz()
    Dim f$, p$, wb As Workbook, a(1 To 36, 1 To 1), b(1 To 36, 1 To 1), a1, b1, c
    Application.ScreenUpdating = False
    Set wb = ThisWorkbook
    wb.Sheets("sheet1").[a2].Resize(100, 100).ClearContents
    wb.Sheets("汇总表").Range("b:b,d:d").ClearContents
    p = ThisWorkbook.Path & "\"
    f = Dir(p & "*.xls")
    Do While Len(f)
        If f <> ThisWorkbook.Name Then
            With GetObject(p & f)
                a1 = .Sheets(1).Range("e3:e38")
                b1 = .Sheets(1).Range("j3:j38")
                c = Split(f, ".")(0)
                .Close False
            End With
            With wb.Sheets("Sheet1")
                .Cells(3, 1 + n).Resize(UBound(a1), 1) = a1
                .Cells(3, 2 + n).Resize(UBound(b1), 1) = b1
                .Cells(2, 1 + n) = c
                n = n + 3
            End With
            For i = 2 To UBound(a)
                a(i, 1) = a(i, 1) + a1(i, 1)
                b(i, 1) = b(i, 1) + b1(i, 1)
            Next
        End If
        f = Dir
    Loop
    Sheet1.[b3].Resize(UBound(a)) = a
    Sheet1.[d3].Resize(UBound(b)) = b
    Application.ScreenUpdating = True
End Sub

zax010

liurongyue 发表于 2014-11-22 13:55
需要复制每个表的E列和J列并汇总

>>>>>>>>>>>>>>>>>>>>>
汇总表格.rar (32.87 KB, 下载次数: 27)

2014-11-22 18:23 上传

点击文件名下载附件

liurongyue

感谢老师的帮助，解决大问题了。

kszcs

zax010 发表于 2014-11-22 18:23
>>>>>>>>>>>>>>>>>>>>>

zax010你好：
能帮忙看看怎么修改15楼的代码汇总吗
谢谢！

liurongyue

你试一下，

kszcs

liurongyue 发表于 2014-11-26 20:07
你试一下，

红色单元格的C4、D3、D3、G3的数据串行或缺少

kszcs

liurongyue 发表于 2014-11-26 20:07
你试一下，

问题解决，
只是wb.Sheets("sheet1").[c4].Resize(1, 2).ClearContents是什么含义？