[已解决]多个工作表数据按条件汇总

网络人

chart888 发表于 2017-6-3 15:29

最下面能增加个汇总的行么

chart888

网络人 发表于 2017-6-5 12:52
最下面能增加个汇总的行么

什么意思？
你把要求说详细点
最好能给我一个模拟的结果
你的这个目录我看的有点不伦不类
应该不是最终的吧
序列为什么要那么多
不是重复吗

网络人

chart888 发表于 2017-6-5 12:54
什么意思？
你把要求说详细点
最好能给我一个模拟的结果

序列和加盟商名称都只保留一个。就是这个汇总表下面增加整列的汇总

chart888

1. Private Sub CommandButton1_Click()
   
2. 
   
3. Application.ScreenUpdating = False
   
4. Application.DisplayAlerts = False
   
5. 
   
6. Dim wt As Worksheet
   
7. Dim i, i1, i2, r, AA, BB As Integer
   
8. Dim Arr
   
9. Dim regex
   
10. 
    
11. Set regex = CreateObject("vbscript.regexp")
    
12. regex.Pattern = "\d+"
    
13. With Sheets("目录")
    
14.     AA = regex.Execute(.Cells(1, 1).Value)(0) * 1
    
15.     .Range("A3:O" & Rows.Count).ClearContents
    
16.     For Each wt In Worksheets
    
17.         If wt.Name <> "目录" Then
    
18.             r = wt.Range("A65536").End(xlUp).Row
    
19.             wt.Cells(r, 5) = WorksheetFunction.Sum(wt.Range(Cells(4, 5).Address, Cells(r - 1, 5).Address))
    
20.             wt.Cells(r, 6) = WorksheetFunction.Sum(wt.Range(Cells(4, 6).Address, Cells(r - 1, 6).Address))
    
21.             For i1 = 4 To r - 1
    
22.                 wt.Cells(i1, 7) = wt.Cells(i1 - 1, 7) + wt.Cells(i1, 6) - wt.Cells(i1, 5)
    
23.                 wt.Cells(r, 7) = wt.Cells(r - 1, 7)
    
24.             Next
    
25.             BB = regex.Execute(wt.Cells(r, 1).Value)(0) * 1
    
26.             i2 = .Range("B65536").End(xlUp).Row + 1
    
27.             If AA = BB Then
    
28.                 .Cells(i2, 1) = i2 - 2
    
29.                 .Cells(i2, 2) = wt.Name
    
30.                 .Cells(i2, 3) = wt.Cells(r, 7)
    
31.                 .Cells(i2, 5) = wt.Cells(r, 5)
    
32.                 .Cells(i2, 6) = wt.Cells(r, 6)
    
33.                 .Cells(i2, 7) = wt.Cells(3, 7)
    
34.                 ActiveSheet.Hyperlinks.Add Anchor:=Cells(i2, 2), Address:="", _
    
35.                 SubAddress:=wt.Name & "!A1", TextToDisplay:=Cells(i2, 2).Value
    
36.             Else
    
37.                 .Cells(i2, 1) = i2 - 2
    
38.                 .Cells(i2, 2) = wt.Name
    
39.                 .Cells(i2, 3) = wt.Cells(r, 7)
    
40.                 .Cells(i2, 7) = wt.Cells(3, 7)
    
41.                 ActiveSheet.Hyperlinks.Add Anchor:=Cells(i2, 2), Address:="", _
    
42.                 SubAddress:=wt.Name & "!A1", TextToDisplay:=Cells(i2, 2).Value
    
43.             End If
    
44.         End If
    
45.     Next
    
46.     .Cells(i2 + 1, 1) = "合计"
    
47.     .Cells(i2 + 1, 3) = WorksheetFunction.Sum(.Range(Cells(3, 3).Address, Cells(i2, 3).Address))
    
48.     .Cells(i2 + 1, 5) = WorksheetFunction.Sum(.Range(Cells(3, 5).Address, Cells(i2, 5).Address))
    
49.     .Cells(i2 + 1, 6) = WorksheetFunction.Sum(.Range(Cells(3, 6).Address, Cells(i2, 6).Address))
    
50.     .Cells(i2 + 1, 7) = WorksheetFunction.Sum(.Range(Cells(3, 7).Address, Cells(i2, 7).Address))
    
51.     .Range("A2:G2").EntireColumn.AutoFit
    
52.     With .Range("A2").CurrentRegion.Borders
    
53.         .LineStyle = xlContinuous
    
54.         .Weight = xlThin
    
55.     End With
    
56.         With .Range("A2").Resize(i2, 7)
    
57.             .VerticalAlignment = xlCenter
    
58.             .HorizontalAlignment = xlCenter
    
59.             .Font.Name = "微软雅黑"
    
60.             .Font.Size = 11
    
61.         End With
    
62. End With
    
63. 
    
64. Application.ScreenUpdating = True
    
65. Application.DisplayAlerts = True
    
66. End Sub

复制代码

网络人

chart888 发表于 2017-6-5 13:15

非常感谢！

网络人

chart888 发表于 2017-6-5 13:15

•             ActiveSheet.Hyperlinks.Add Anchor:=Cells(i2, 2), Address:="", _
•             SubAddress:=wt.Name & "!A1", TextToDisplay:=Cells(i2, 2).Value这个 代码能解释下么还有我想把名称放在第3列怎么修改代码
•           .Cells(i2, 3) = wt.Name
  

chart888

网络人 发表于 2017-6-6 12:52

            ActiveSheet.Hyperlinks.Add Anchor:=Cells(i2, 2), Address:="", _

            S ...

ActiveSheet.Hyperlinks.Add Anchor:=Cells(i2, 2), Address:="", _
                SubAddress:=wt.Name & "!A1", TextToDisplay:=Cells(i2, 2).Value

这句就是加超链接的
Anchor:=Cells(i2, 2)   第2列加超链接
TextToDisplay:=Cells(i2, 2).Value   超链接的文本为第2列的文本
比如i2=3时  就是在第三行第2列加一个超链接，超链接的名字为第三行第2列内的文本

网络人

chart888 发表于 2017-6-6 13:04
ActiveSheet.Hyperlinks.Add Anchor:=Cells(i2, 2), Address:="", _
                SubAddress:=wt.Na ...

如果改成第3列修改那些

chart888

网络人 发表于 2017-6-6 13:31
如果改成第3列修改那些

你现在第三列不是有内容的？
ActiveSheet.Hyperlinks.Add Anchor:=Cells(i2, 3), Address:="", _
                SubAddress:=wt.Name & "!A1", TextToDisplay:=Cells(i2, 2).Value

网络人

chart888 发表于 2017-6-6 13:39
你现在第三列不是有内容的？
ActiveSheet.Hyperlinks.Add Anchor:=Cells(i2, 3), Address:="", _
      ...

第三列和第二列互换位置