明了的数量汇总显示

向東

2.0版本来了，绝对原创，分享给大家。

明了的数量汇总显示.rar (26.21 KB, 下载次数: 14)

2018-7-26 22:02 上传

点击文件名下载附件

1. Private Sub CommandButton2_Click() ' 汇总
   
2.     Dim r, i, j, h, M As Long
   
3.     Dim Rng As Variant
   
4.    
   
5. 
   
6.     r = Worksheets("汇总表").Range("C65536").End(xlUp).Row
   
7.     Rng = Worksheets("汇总表").Range("A1:I" & r).Value
   
8.    
   
9. '------------------------------------------------------------------------按 仓位、货品编码 排序
   
10.    Application.ScreenUpdating = True
    
11. 
    
12.     Range("A2:I" & r).Sort Key1:=Range("D2"), Order1:=xlAscending, Key2:=Range("E2") _
    
13.         , Order2:=xlAscending, Key3:=Range("G2"), Order3:=xlAscending, Header:=xlNo, OrderCustom:=1, MatchCase:=True _
    
14.         , Orientation:=xlTopToBottom, SortMethod:=xlPinYin, DataOption1:= _
    
15.         xlSortNormal, DataOption2:=xlSortNormal
    
16. 
    
17. '------------------------------------------------------------------------按 货品名 对 大于1的数量求和
    
18.     r = Worksheets("汇总表").Range("C65536").End(xlUp).Row
    
19.     Rng = Worksheets("汇总表").Range("A1:I" & r).Value
    
20.    
    
21.       M = 2
    
22. 
    
23. f:    For i = M To r
    
24.            If Rng(i - 1, 5) = Rng(i, 5) And Rng(i, 7) >= 1 And Rng(i - 1, 8) = "□" Then   '商品编码 与上一行相同， 且 数量大于等于1 ，且 上一行 核对列 为"□" （核对列 除了数量是小数外，全部是"□"）
    
25. 
    
26.              h = 2
    
27.              For j = i + 1 To r '查询有多少相同的行
    
28.                 If Rng(i, 5) = Rng(j, 5) And Rng(j, 7) >= 1 Then 'rng(j,7) 第7列是数量
    
29.                     h = h + 1 '累计行数
    
30.                 End If
    
31.              Next
    
32.             
    
33.             If h = 2 Then '两行相同 的商品编码
    
34.                 If ((Rng(i - 1, 7) + Rng(i, 7))) < 10 Then
    
35.                     Range("H" & i - 1) = "╮  "
    
36.                     Range("H" & i) = "╯" & (Rng(i - 1, 7) + Rng(i, 7)) & " " '1位数字，多加个空格，看起来整齐。
    
37.                 Else
    
38.                     Range("H" & i - 1) = "╮  "
    
39.                     Range("H" & i) = "╯" & (Rng(i - 1, 7) + Rng(i, 7))
    
40.                 End If
    
41.             ElseIf h > 2 Then
    
42.                 Range("H" & i - 1) = "─╮"
    
43.                 Range("H" & i & ":H" & i + h - 3) = "│"
    
44.                 Range("H" & i + Int(h / 2) - 1).Formula = "=SUM(G" & i - 1 & ":G" & i + h - 2 & ")" '汇总数量（奇数行覆盖上一行内容）
    
45.                 Range("H" & i + h - 2) = "─╯"
    
46.             End If
    
47.             
    
48. 
    
49.             M = i + h
    
50.             GoTo f
    
51.            End If
    
52.     Next
    
53. 
    
54. 
    
55.     Range("F2:H" & r).Select '选择 需要打印的 区域
    
56.     Application.ScreenUpdating = False
    
57. '------------------------------------------------------------------------打印 汇总
    
58.     If MsgBox("要先【打印】此汇总单吗？", vbQuestion + vbYesNo, "打印提示") = vbYes Then
    
59.         ActiveSheet.PageSetup.PrintArea = ActiveSheet.Range("F2:H" & r).Address '设置选择区域 为打印区域
    
60.         ActiveSheet.PrintOut Copies:=1, Collate:=True
    
61.     End If
    
62. End Sub

复制代码

向東

我觉得这种汇总方法比 分类汇总 明了