|
- Private Sub CommandButton1_Click()
- Application.ScreenUpdating = False
- Application.DisplayAlerts = False
- Dim wt As Worksheet
- Dim i, i1, i2, r, AA, BB As Integer
- Dim Arr
- Dim regex
- Set regex = CreateObject("vbscript.regexp")
- regex.Pattern = "\d+"
- With Sheets("目录")
- AA = regex.Execute(.Cells(1, 1).Value)(0) * 1
- .Range("A3:O" & Rows.Count).ClearContents
- For Each wt In Worksheets
- If wt.Name <> "目录" Then
- r = wt.Range("A65536").End(xlUp).Row
- wt.Cells(r, 5) = WorksheetFunction.Sum(wt.Range(Cells(4, 5).Address, Cells(r - 1, 5).Address))
- wt.Cells(r, 6) = WorksheetFunction.Sum(wt.Range(Cells(4, 6).Address, Cells(r - 1, 6).Address))
- For i1 = 4 To r - 1
- wt.Cells(i1, 7) = wt.Cells(i1 - 1, 7) + wt.Cells(i1, 6) - wt.Cells(i1, 5)
- wt.Cells(r, 7) = wt.Cells(r - 1, 7)
- Next
- BB = regex.Execute(wt.Cells(r, 1).Value)(0) * 1
- i2 = .Range("B65536").End(xlUp).Row + 1
- If AA = BB Then
- .Cells(i2, 1) = i2 - 2
- .Cells(i2, 3) = wt.Name
- .Cells(i2, 2) = wt.Cells(r, 7)
- .Cells(i2, 5) = wt.Cells(r, 5)
- .Cells(i2, 6) = wt.Cells(r, 6)
- .Cells(i2, 7) = wt.Cells(3, 7)
- ActiveSheet.Hyperlinks.Add Anchor:=Cells(i2, 3), Address:="", _
- SubAddress:=wt.Name & "!A1", TextToDisplay:=Cells(i2, 3).Value
- Else
- .Cells(i2, 1) = i2 - 2
- .Cells(i2, 3) = wt.Name
- .Cells(i2, 2) = wt.Cells(r, 7)
- .Cells(i2, 7) = wt.Cells(3, 7)
- ActiveSheet.Hyperlinks.Add Anchor:=Cells(i2, 3), Address:="", _
- SubAddress:=wt.Name & "!A1", TextToDisplay:=Cells(i2, 3).Value
- End If
- End If
- Next
- .Cells(i2 + 1, 1) = "合计"
- .Cells(i2 + 1, 3) = WorksheetFunction.Sum(.Range(Cells(3, 3).Address, Cells(i2, 3).Address))
- .Cells(i2 + 1, 5) = WorksheetFunction.Sum(.Range(Cells(3, 5).Address, Cells(i2, 5).Address))
- .Cells(i2 + 1, 6) = WorksheetFunction.Sum(.Range(Cells(3, 6).Address, Cells(i2, 6).Address))
- .Cells(i2 + 1, 7) = WorksheetFunction.Sum(.Range(Cells(3, 7).Address, Cells(i2, 7).Address))
- .Range("A2:G2").EntireColumn.AutoFit
- With .Range("A2").CurrentRegion.Borders
- .LineStyle = xlContinuous
- .Weight = xlThin
- End With
- With .Range("A2").Resize(i2, 7)
- .VerticalAlignment = xlCenter
- .HorizontalAlignment = xlCenter
- .Font.Name = "微软雅黑"
- .Font.Size = 11
- End With
- End With
- Application.ScreenUpdating = True
- Application.DisplayAlerts = True
- End Sub
复制代码
|
|