需求如下,文件下有某网站的来自某运营商十大节点流量汇总,每个文件内为每天忙时19-21点流量统计,实现所有数据累加汇总,并且完成绘图功能。若有实现自动化操作excel朋友可以在线联系小编。
小编【shellbat】总计花了一天时间完成此项工作,能兴趣的小伙伴可以可以自己尝试,需要原始数据可以联系小编索取。
具体vba代码如下:
Sub 宏1()
On Error Resume Next
Dim MyPath, MyName, AWbName
Dim Wb As Workbook, WbN As String
Dim Num As Long
Dim BOX As String
Dim rows As Long
Application.ScreenUpdating = False
Columns("A:I").ClearContents
Application.CutCopyMode = False
MyPath = ActiveWorkbook.Path
MyName = Dir(MyPath & "\" & "*.xls")
AWbName = ActiveWorkbook.Name
'Application.WindowState = xlMinimized
Num = 0
'累加数值
Do While MyName <> ""
If MyName <> AWbName Then
Set Wb = Workbooks.Open(MyPath & "\" & MyName)
Num = Num + 1
If Num = 1 Then
Workbooks(MyName).Activate
rws = Worksheets(1).Range("A65535").End(xlUp).Row
Range("A1:I" & rws).Copy
ThisWorkbook.Activate
Range("A1").Select
ActiveSheet.Paste
Range("Q24").Copy
Range("C4:I" & rws).Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlAdd, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
'Application.WindowState = xlMinimized
Else
Workbooks(MyName).Activate
Range("C7:I" & rws).Copy
ThisWorkbook.Activate
Range("C7").PasteSpecial Paste:=xlPasteAll, Operation:=xlAdd, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
'Application.WindowState = xlMinimized
End If
If Num Mod 5 = 1 And Num <> 1 Then
WbN = WbN & Chr(13) & Wb.Name
ElseIf Num = 1 Then
WbN = Wb.Name
Else
WbN = WbN & " " & Wb.Name
End If
Application.DisplayAlerts = False
Wb.Close False
End If
MyName = Dir
Loop
'求最大,平均,最小
ThisWorkbook.Activate
Range("C4:I6").ClearContents
Range("C4").FormulaR1C1 = "=MAX(R[3]C:R[" & rws - 4 & "]C)"
Range("C5").FormulaR1C1 = "=AVERAGE(R[2]C:R[" & rws - 5 & "]C)"
Range("C6").FormulaR1C1 = "=MIN(R[1]C:R[" & rws - 6 & "]C)"
Range("C4:C6").Select
Selection.AutoFill Destination:=Range("C4:I6"), Type:=xlFillDefault
Range("C4:I6").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
'制作图表
'Application.WindowState = xlMaximized
ThisWorkbook.Activate
ActiveSheet.ChartObjects("chart1").Activate
ActiveChart.Parent.Delete
Range("B3,D3:I3,B7:B" & rws & ",D7:" & rws).Select
Range("B7").Activate
ActiveSheet.Shapes.AddChart2(227, xlLineStacked).Select
ActiveChart.SetSourceData Source:=Range("Sheet1!$B$3,Sheet1!$D$3:$I$3,Sheet1!$D$7:$I$" & rws & ",Sheet1!$B$7:$B$" & rws)
ActiveChart.Parent.Name = "chart1"
ActiveSheet.Shapes("chart1").IncrementLeft 205
ActiveSheet.Shapes("chart1").IncrementTop 18.5
ActiveSheet.Shapes("chart1").ScaleWidth 1.225, msoFalse, msoScaleFromTopLeft
ActiveSheet.Shapes("chart1").ScaleHeight 1#, msoFalse, msoScaleFromTopLeft
ActiveChart.ChartTitle.Delete
ActiveSheet.ChartObjects("chart1").Activate
ActiveChart.PlotArea.Select
ActiveChart.ChartType = xlLine
Application.CommandBars("Format Object").Visible = False
ThisWorkbook.Activate
Application.ScreenUpdating = True
'Windows("all.xlsm").Activate
ThisWorkbook.Activate
ActiveWindow.FreezePanes = False
ActiveWindow.SmallScroll Down:=0
Sheets(1).Range("A1").Select
ThisWorkbook.Save
MsgBox "累加计算数据" & Num & "个工作表。如下:" & Chr(13) & WbN, vbInformation, "完成提示,by shellbat!"
End Sub