才做的应付款汇总，大家看看能不能写的更简单点

macan558

我学着一位前辈写的宏小小的改了一下，但还是没有达到我想要的效果，希望各位大大帮我改一下。
例：同一工作簿有若干个工作表，第一个工作表作为汇总表。
汇总表的第二列和第六列显示各工作表的名称的超链接，现在第二列已经可以完成新增单位的自动生成工作表、名称、内容。

希望第六列的单位也可以自动生成工作表、名称、内容，第二列和第六列的新增单位在自动生成工作表的同时自动在新增单位的名称上添加到相应工作表的超链接。
第三列和第七列即时显示各单位相应工作表上指定单元格的数值之和：例如 =SUM(鑫龙!C2:C99)
谢谢各位大大了。如果还能实现12个月各自月份的相应汇总就更好了，但是各月份的汇总不能以日期来汇总。例如：供货商4月份发货的单，我单位没有在4月份入库，而是在5月份入库，那在和供货商对4月份的帐时就不需要对到这张单，在对5月的帐时才需要对到这张单。所以不能不能以日期来汇总。
以下我的宏和工作簿



Sub 自动增加工作表()
    Dim K&, N&, SH As Worksheet, SHN As Worksheet
    Set SH = Sheets("汇总表")
    SH.Activate
    N = [B65536].End(xlUp).Row - 5
    K = 3
    For I = 1 To N                                      '初步统计要新建的工作表数量
        Do While Cells(K, 2) <> ""
            For Each SHN In Worksheets                  '检查即将要建立的工作表是否已经存在
                If SHN.Name = Cells(K, 2) Then
                    Sheets(SHN.Name).Activate
                    [h3] = SH.Cells(K, 4)
                    SH.Activate
                    Exit Do
                End If
            Next
                    Application.Worksheets.Add after:=Sheets(2)
                    ActiveSheet.Name = SH.Cells(K, 2).Value    '增加新工作表
                    Sheets(2).Cells.Copy [a1]                  '更改新增加工作表的名称
                    [h3] = SH.Cells(K, 4)                      '在新工作表上复制Sheets(2)的内容
                    SH.Activate
                    K = K + 1
        Loop
        K = K + 1
    Next
End Sub

[ 本帖最后由 macan558 于 2010-8-28 14:30 编辑 ]

macan558

怎么没有前辈在吗？急啊！

macan558

我学着一位前辈写的宏小小的改了一下，但还是没有达到我想要的效果，希望各位大大帮我改一下。
例：同一工作簿有若干个工作表，第一个工作表作为汇总表。
汇总表的第二列和第六列显示各工作表的名称的超链接，现在第二列已经可以完成新增单位的自动生成工作表、名称、内容。
希望第六列的单位也可以自动生成工作表、名称、内容，第二列和第六列的新增单位在自动生成工作表的同时自动在新增单位的名称上添加到相应工作表的超链接。
第三列和第七列即时显示各单位相应工作表上指定单元格的数值之和：例如 =SUM(鑫龙!C2:C99)
谢谢各位大大了。如果还能实现12个月各自月份的相应汇总就更好了，但是各月份的汇总不能以日期来汇总。例如：供货商4月份发货的单，我单位没有在4月份入库，而是在5月份入库，那在和供货商对4月份的帐时就不需要对到这张单，在对5月的帐时才需要对到这张单。所以不能不能以日期来汇总。
以下我的宏和工作簿



Sub 自动增加工作表()
    Dim K&, N&, SH As Worksheet, SHN As Worksheet
    Set SH = Sheets("汇总表")
    SH.Activate
    N = [B65536].End(xlUp).Row - 5
    K = 3
    For I = 1 To N                                      '初步统计要新建的工作表数量
        Do While Cells(K, 2) <> ""
            For Each SHN In Worksheets                  '检查即将要建立的工作表是否已经存在
                If SHN.Name = Cells(K, 2) Then
                    Sheets(SHN.Name).Activate
                    [h3] = SH.Cells(K, 4)
                    SH.Activate
                    Exit Do
                End If
            Next
                    Application.Worksheets.Add after:=Sheets(2)
                    ActiveSheet.Name = SH.Cells(K, 2).Value    '增加新工作表
                    Sheets(2).Cells.Copy [a1]                  '更改新增加工作表的名称
                    [h3] = SH.Cells(K, 4)                      '在新工作表上复制Sheets(2)的内容
                    SH.Activate
                    K = K + 1
        Loop
        K = K + 1
    Next
End Sub

macan558

我来顶上去

macan558

怎么没有人回复呢？各位大大啊！帮帮我吧！我觉得我自己做的这个表太笨了