[VBA求助]请帮忙编辑个VBA相同图号的数量求和后合并

天蚕宝宝

请帮忙编辑个VBA相同图号的数量求和后合并
具体见附件，有劳各位老师

coolall

1. Sub test()
   
2. Dim i As Integer
   
3. Row = Cells(Rows.Count, 1).End(xlUp).Row
   
4. k = 1
   
5.     For i = 5 To Row
   
6.         If Cells(i, 1) <> Cells(i + 1, 1) Then
   
7.             If k = 1 Then
   
8.             Cells(i, 7) = "=SUM(B5:B" & Trim(Str(i)) & ")"
   
9.             Call merge(5, i)
   
10.             Else
    
11.             Cells(i, 7) = "=SUM(B" & Trim(Str(k + 1)) & ":B" & Trim(Str(i)) & ")"
    
12.             Call merge((k + 1), i)
    
13.             End If
    
14.             k = i
    
15.         End If
    
16.     Next i
    
17. End Sub
    
18. 
    
19. Function merge(i As Integer, j As Integer)
    
20. strNanme = "G" & Trim(Str(i)) & ":G" & Trim(Str(j)) & ""
    
21.     Range(strNanme).Select
    
22.     With Selection
    
23.         .HorizontalAlignment = xlCenter
    
24.         .VerticalAlignment = xlBottom
    
25.         .WrapText = False
    
26.         .Orientation = 0
    
27.         .AddIndent = False
    
28.         .IndentLevel = 0
    
29.         .ShrinkToFit = False
    
30.         .ReadingOrder = xlContext
    
31.         .MergeCells = False
    
32.     End With
    
33.     Selection.merge
    
34.     Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    
35.     Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    
36.     With Selection.Borders(xlEdgeLeft)
    
37.         .LineStyle = xlContinuous
    
38.         .ColorIndex = 0
    
39.         .TintAndShade = 0
    
40.         .Weight = xlThin
    
41.     End With
    
42.     With Selection.Borders(xlEdgeTop)
    
43.         .LineStyle = xlContinuous
    
44.         .ColorIndex = 0
    
45.         .TintAndShade = 0
    
46.         .Weight = xlThin
    
47.     End With
    
48.     With Selection.Borders(xlEdgeBottom)
    
49.         .LineStyle = xlContinuous
    
50.         .ColorIndex = 0
    
51.         .TintAndShade = 0
    
52.         .Weight = xlThin
    
53.     End With
    
54.     With Selection.Borders(xlEdgeRight)
    
55.         .LineStyle = xlContinuous
    
56.         .ColorIndex = 0
    
57.         .TintAndShade = 0
    
58.         .Weight = xlThin
    
59.     End With
    
60.     Selection.Borders(xlInsideVertical).LineStyle = xlNone
    
61.     Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    
62.     With Selection.Interior
    
63.         .Pattern = xlSolid
    
64.         .PatternColorIndex = xlAutomatic
    
65.         .ThemeColor = xlThemeColorAccent3
    
66.         .TintAndShade = 0.399975585192419
    
67.         .PatternTintAndShade = 0
    
68.     End With
    
69. End Function
    

复制代码

coolall

是不是你的需求

天蚕宝宝

coolall 发表于 2016-12-8 10:39
是不是你的需求

非常感谢，稍微改改已经可以用了