代码如何添加：不对指定工作表“分类”进行“汇总”的语句？

ruhong18

Sub 汇总()
     Dim sht As Worksheet
     Dim k As Date
     Dim brr(1 To 600000, 1 To 9)
     k = Sheet7.[J3]
     For Each sht In Sheets
         If sht.Name <> "汇总" Then
             arr = sht.UsedRange.Value
             For i = 4 To UBound(arr) Step 13
                 If arr(i, 10) = k Then
                      For j = i + 2 To i + 5
                      If arr(j, 4) <> "" Then
                     n = n + 1
                     brr(n, 1) = n
                     brr(n, 2) = arr(i, 5)
                     brr(n, 3) = arr(j, 4)
                     brr(n, 5) = arr(j, 7): A = A + arr(j, 7)
                     brr(n, 6) = arr(j, 8): B = B + arr(j, 8)
                     brr(n, 7) = arr(j, 9)
                     brr(n, 8) = arr(j, 10): c = c + arr(j, 10)
                     brr(n, 9) = arr(j, 11)
                     End If
                      Next
                 End If
             Next
         End If
     Next
     n = n + 1
     brr(n, 1) = "合计"
     brr(n, 5) = A: brr(n, 6) = B: brr(n, 8) = c
     Sheet7.UsedRange.Offset(4).ClearContents
     Sheet7.[B5].Resize(n, 9) = brr
End Sub

hfwufanhf2006

你这个问题我看了好久，就是看不懂：“不对指定工作表汇总”到底是什么意思？
如果不指定工作表就意味着对当前工作表做汇总了，是这个意思吗？
如果是，不指定工作表前缀就行了，两者的差别：
s=worksheets(1).cells(1,1)   ‘读取第一个工作表的a1单元格
s1=cells(1,1)                      '读取当前工作表a1单元格
何为当前工作表？就是执行代码的工作表，也就是开始执行代码时眼睛视野看见的那个工作表。代码是能够更改当前工作表位置的，因此只要不是用代码进行了切换，当前工作表就会一直固定为代码开始执行的那个表。如果用代码切换了，当前工作表也就随之改变了。

你的代码别人看不懂，因为不了解你的数据结构，瞎猜是很困难的事情。
仅就结构而言，你使用 For Each sht In Sheets 循环了所有的表，这种情况下指定或者不指定工作表并没有实际意义，工作表变量 sht 就是你处理数据的当前焦点，这个变量并不是特指哪一个表，是所有表的逐个循环。至于后续的代码，都是用数组在做某种统计或者变换，这个要与具体数据联系起来才好分析。

ruhong18

hfwufanhf2006 发表于 2019-12-4 01:25
你这个问题我看了好久，就是看不懂：“不对指定工作表汇总”到底是什么意思？
如果不指定工作表就意味着对 ...

已上传附件

hfwufanhf2006

ruhong18 发表于 2019-12-4 09:24
已上传附件

这两天在写年度总结，没及时回复。
先说一声，等有空帮你写。

ruhong18

hfwufanhf2006 发表于 2019-12-5 12:16
这两天在写年度总结，没及时回复。
先说一声，等有空帮你写。

好的,多谢~

hfwufanhf2006

ruhong18 发表于 2019-12-5 13:42
好的,多谢~

代码写好了，你先去试下效果。有一个数据我找不到：颜色，那一栏就只能空着；


你这个表我感觉似曾相识，我似乎也曾写过类似的代码。当然重写一次也没有多大难度。

如果你自己有vba代码基础，可以自己根据需要修改，没基础就不要乱改，尤其是前两个表的顺序不要动，因为代码是指定从第三个表开始汇总到最后一个表，然后把汇总结果写入到当前表中。

下面是一些重要参数的说明，便与你自己修改代码，只对我认为关键的地方做说明：

Dim arr(1 To 100, 6)     '定义数组，分别对应c到J列，但不包含e列的颜色，如果你需要颜色，就把数组列数再增加到 7 ；

    数组的最大行是100，这个我不确定，你根据需要增减；
hs = 5                        '起始行是第5行，前面是表头
ri = Cells(3, "j")           '读出日期
For i = 3 To Worksheets.Count      '从第3个表统计到最后一个，第2个表我不知道是干什么的，我也没管它


        If Worksheets(i).Cells(k, "j") = ri Then   '对符合日起定义的记录进行统计

           For j = 1 To 4      '每个单元最大为 4 行，如果你修改了单元最大行数，这里相应变化

               bz = False       '下面是数组检索，判断是否是重复数据，重复的数据进行合并统计，不重复的新增数据就添加到数组的后面
               For l = 1 To js
                   If Worksheets(i).Cells(k + j + 1, 4) = arr(l, 1) Then
                      bz = True
                      ls = l
                      Exit For
                   End If
               Next l

               If bz Then    '这里是重复数据的处理，只统计数量、重量、金额，文本类型的不需要合并
                  arr(l, 2) = arr(l, 2) + Worksheets(i).Cells(k + j + 1, 7)
                  arr(l, 3) = arr(l, 2) + Worksheets(i).Cells(k + j + 1, 8)
                  arr(l, 5) = arr(l, 2) + Worksheets(i).Cells(k + j + 1, 10)
               Else            '下面是新增的不重复数据，要写入完整的全部数据到数组
                  js = js + 1
                  arr(js, 1) = Worksheets(i).Cells(k + j + 1, 4)
                  arr(js, 2) = Worksheets(i).Cells(k + j + 1, 7)
                  arr(js, 3) = Worksheets(i).Cells(k + j + 1, 8)
                  arr(js, 4) = Worksheets(i).Cells(k + j + 1, 9)
                  arr(js, 5) = Worksheets(i).Cells(k + j + 1, 10)
                  arr(js, 6) = Worksheets(i).Cells(k + j + 1, 11)
               End If

    For k = 1 To js     '把数组写入当前汇总表，颜色那一列是跳过的
        Cells(hs, 2) = hs - 4
        Cells(hs, 3) = Worksheets(i).Name
        Cells(hs, 4) = arr(k, 1)
        Cells(hs, 6) = arr(k, 2)
        Cells(hs, 7) = arr(k, 3)
        Cells(hs, 8) = arr(k, 4)
        Cells(hs, 9) = arr(k, 5)
        Cells(hs, 10) = arr(k, 6)
        hs = hs + 1
    Next k

下面是写入最后的总合计，用的是sum函数。用代码汇总也行，只是觉得没必要。工作表函数我认为就这个是可以随便用的，其他的不建议用：
Cells(hs, 2) = "合 计"
Cells(hs, 6) = "=sum(f5:f" & hs - 1 & ")"
Cells(hs, 7) = "=sum(g5:g" & hs - 1 & ")"
Cells(hs, 9) = "=sum(i5:i" & hs - 1 & ")"

ruhong18

hfwufanhf2006 发表于 2019-12-6 10:27
代码写好了，你先去试下效果。有一个数据我找不到：颜色，那一栏就只能空着；

首先非常感谢您这么详细代码和耐心的指定，经测试，总体方向和效果是达到理想，就是有一个工作表经测试，条数是对的，但是重量有误（不知不是是您说的找不到数据），另外一个就是只要提取每个单据里面的4行内容就可以，不用对它进行合并汇总；

hfwufanhf2006

ruhong18 发表于 2019-12-6 11:50
首先非常感谢您这么详细代码和耐心的指定，经测试，总体方向和效果是达到理想，就是有一个工作表经测试， ...

测试代码的时候，统计出来的数据与你的样本结果是一模一样的我才发上去的。
如有不对，你具体说出来是哪一个数据，我好查找原因。

ruhong18

hfwufanhf2006 发表于 2019-12-6 12:42
测试代码的时候，统计出来的数据与你的样本结果是一模一样的我才发上去的。
如有不对，你具体说出来是哪 ...

您好，已上传待修改附件，出错位置用颜色标记着，黄色位置重量不对，麻烦您看下~  还有看看能否保存为2003版本的，如果没有就算，不用2003也可以

hfwufanhf2006

ruhong18 发表于 2019-12-6 14:01
您好，已上传待修改附件，出错位置用颜色标记着，黄色位置重量不对，麻烦您看下~  还有看看能否保存为200 ...

1、有一个的地方的代码有问题，你自己修改，我不上传了，具体位置：
               If bz Then
                  arr(l, 2) = arr(l, 2) + Worksheets(i).Cells(k + j + 1, 7)
                  arr(l, 3) = arr(l, 2) + Worksheets(i).Cells(k + j + 1, 8)     '把 arr(l,2) 改成 arr(l,3)，中间是字母L的小写，不是数字1或者字母i
                  arr(l, 5) = arr(l, 2) + Worksheets(i).Cells(k + j + 1, 10)   '把 arr(l,2) 改成 arr(l,5)
      当时是先写好一行，后面用了复制，但参数忘记改了；
      这个错误也很明显，arr(l,3) 不可能与 arr(l,2) 相加，当然是对自己 arr(l,3) 累加了；
      修改后的结果：
                  arr(l, 3) = arr(l, 3) + Worksheets(i).Cells(k + j + 1, 8)
                  arr(l, 5) = arr(l, 5) + Worksheets(i).Cells(k + j + 1, 10)


2、关于版本，我没有2003，你就把代码复制，再粘贴到2003版本即可