请教多区块汇总的vba语句

microyip

SQL语句Select一下，排除B列是“单位”或空之后，结果就出来啦

byrdhcl

请各位老师帮忙修改下。
附件中是我“装箱单制作文件”，该贴请教的问题也是其中的一部分，目前功能基本完成，还能用。但是看了两位老师的代码，我还是感到我原来的代码效率低下，不完善。尤其大数量数据时，速度慢。我也是刚接触vba，思索再三不得其门而入。所以麻烦各位老师给修改完善下。
我的原思路：
1、两个表，分别有男组合女组。我合并到一张表。此部分我手工操作，未写代码，放在文件的第一个表“装箱单制作”中。
2、以第三列关键字排序，将男女同一部门的人员排到一起，此部分未写代码，在文件中此步未进行。希望老师给补充代码
3、为各装箱单（一个部门一个装箱单）插入表头（表头模板在公用复制表中），此步是我最不满意的地方，其一速度慢，其二最后装箱单的合计未插入，第一个装箱单的表头未插入，没办法我只有进行第4步。其三，指定搜索区域很麻烦，能不能直接搜索，默认全文搜索。
4、插入最后一个装箱单合计和第一个装箱单表头。
5、计算、写入总箱数，以及装箱单序号。
6、对所有装箱单汇总。


这是我的思路，各位老师也可按照自己的思路修改完善。

sa3131

byrdhcl 发表于 2018-8-29 15:40
请各位老师帮忙修改下。
附件中是我“装箱单制作文件”，该贴请教的问题也是其中的一部分，目前功能基本完 ...

1. Sub a()
   
2. Application.ScreenUpdating = False
   
3. 
   
4. Sheet4.Cells.Clear
   
5. Sheet4.Cells.Delete Shift:=xlUp
   
6. Sheet1.Columns("A:G").Copy
   
7. 
   
8. With Sheet4
   
9.     .[a1].PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
   
10.         :=False, Transpose:=False
    
11.     .[a1].CurrentRegion.Sort key1:=.[c1], order1:=xlAscending, Header:=xlNo '最先操作是按部门排序
    
12.     Call 宏6
    
13.    
    
14. '原始参数和数据获取
    
15.     ar = .UsedRange: ua = UBound(ar): ua2 = UBound(ar, 2)
    
16.     Set d = CreateObject("scripting.dictionary") '字典:总箱子数
    
17.    
    
18.     For i = 1 To ua
    
19.         d(ar(i, 3)) = ""
    
20.     Next i
    
21.     zxzs = d.Count '总箱子个数
    
22.    
    
23.     Set bw = Sheet3.Rows("1:2")
    
24.     Set bt = Sheet3.Rows("3:6")
    
25.         
    
26.         
    
27. '表格制作
    
28.     For i = ua To 1 Step -1
    
29.         If i = ua Then
    
30.             bw.Copy
    
31.             .Rows(ua + 1).Insert
    
32.         ElseIf i = 1 Then
    
33.             bt.Copy
    
34.             .Rows(1).Insert
    
35.         ElseIf ar(i, 3) <> ar(i - 1, 3) Then
    
36.             bt.Copy
    
37.             .Rows(i).Insert
    
38.             bw.Copy
    
39.             .Rows(i).Insert
    
40.         End If
    
41.     Next i
    
42. 
    
43. '表格美化
    
44.     br = .UsedRange: ub = UBound(br): Kc = 0
    
45.    
    
46.     For i = 1 To ub
    
47.         If br(i, 1) = "序号" Then
    
48.             xc = 0
    
49.         ElseIf br(i, 1) Like "共*箱" Then
    
50.             Kc = Kc + 1
    
51.             .Cells(i, 1) = "共" + Str(zxzs) + "箱 第" + Str(Kc) + "箱"
    
52.         ElseIf br(i, 1) = "合计" Then
    
53.             .Cells(i, 7) = xc
    
54.         ElseIf VBA.IsNumeric(br(i, 1)) Then
    
55.             xc = xc + br(i, 7)
    
56.         End If
    
57.     Next i
    
58.     .Columns("A:G").EntireColumn.AutoFit
    
59. End With
    
60. End Sub

复制代码

byrdhcl

sa3131 发表于 2018-8-29 17:17

谢谢了，测试中

byrdhcl

sa3131 发表于 2018-8-29 17:17

宏6在哪？？？？？？？？？？？？？？？？？

byrdhcl

我把宏6，注释掉，运行测试，速度快，结果也出来了，基本满意，好！不过有点小问题需要调整如图。
1、能不能单元格，数据都居中
2、中间部分要增加格线！

sa3131

byrdhcl 发表于 2018-8-30 08:29
我把宏6，注释掉，运行测试，速度快，结果也出来了，基本满意，好！不过有点小问题需要调整如图。
1、能不 ...

1. Public Sub 宏6()
   
2. '
   
3. ' 宏6 就是美化的代码，包括数据居中和单元格线的
   
4. '
   
5. 
   
6. '
   
7.     Sheet4.[a1].CurrentRegion.Select
   
8.     Selection.Borders(xlDiagonalDown).LineStyle = xlNone
   
9.     Selection.Borders(xlDiagonalUp).LineStyle = xlNone
   
10.     With Selection.Borders(xlEdgeLeft)
    
11.         .LineStyle = xlContinuous
    
12.         .ColorIndex = 0
    
13.         .TintAndShade = 0
    
14.         .Weight = xlThin
    
15.     End With
    
16.     With Selection.Borders(xlEdgeTop)
    
17.         .LineStyle = xlContinuous
    
18.         .ColorIndex = 0
    
19.         .TintAndShade = 0
    
20.         .Weight = xlThin
    
21.     End With
    
22.     With Selection.Borders(xlEdgeBottom)
    
23.         .LineStyle = xlContinuous
    
24.         .ColorIndex = 0
    
25.         .TintAndShade = 0
    
26.         .Weight = xlThin
    
27.     End With
    
28.     With Selection.Borders(xlEdgeRight)
    
29.         .LineStyle = xlContinuous
    
30.         .ColorIndex = 0
    
31.         .TintAndShade = 0
    
32.         .Weight = xlThin
    
33.     End With
    
34.     With Selection.Borders(xlInsideVertical)
    
35.         .LineStyle = xlContinuous
    
36.         .ColorIndex = 0
    
37.         .TintAndShade = 0
    
38.         .Weight = xlThin
    
39.     End With
    
40.     With Selection.Borders(xlInsideHorizontal)
    
41.         .LineStyle = xlContinuous
    
42.         .ColorIndex = 0
    
43.         .TintAndShade = 0
    
44.         .Weight = xlThin
    
45.     End With
    
46.     With Selection
    
47.         .HorizontalAlignment = xlCenter
    
48.         .VerticalAlignment = xlCenter
    
49.         .WrapText = False
    
50.         .Orientation = 0
    
51.         .AddIndent = False
    
52.         .IndentLevel = 0
    
53.         .ShrinkToFit = False
    
54.         .ReadingOrder = xlContext
    
55.         .MergeCells = False
    
56.     End With
    
57. End Sub

复制代码

byrdhcl

sa3131 发表于 2018-8-30 08:45

宏6，测试了一下，总是400错误
再是如果我先以“单位”为主关键字，以“部门”为副关键字，双条件排序（因为还存在不同单位，并且不同单位中还可能存在相同部门，不同单位的相同部门不能制作在一个装箱单中）
.[a1].CurrentRegion.Sort key1:=.[c1], order1:=xlAscending, Header:=xlNo '最先操作是按部门排序
这一句应该怎么写？

byrdhcl

宏6，测试了一下，总是400错误，
我前面加
Sheet4.Activate  解决，

byrdhcl

byrdhcl 发表于 2018-8-30 16:21
宏6，测试了一下，总是400错误
再是如果我先以“单位”为主关键字，以“部门”为副关键字，双条件排序（ ...

我测试了下，如果排序条件变化：以“单位”为主关键字，以“部门”为副关键字，双条件排序（因为还存在不同单位，并且不同单位中还可能存在相同部门，不同单位的相同部门不能制作在一个装箱单中）

1、字典代码，总箱数代码得修改。
2、如果不同单位相同部门的人员排在一起，会放在一个装箱单中。