第二种自动整理数据生成折线图(相同的功能,差别却这么大)

Sub 总模块()
Dim Dic, arr
Dim i As Integer, r As Integer, x1, x2, x3, x4, x5, x6 As Integer
Dim Str, Str1 As String

'拆分字符串,并针对内存数据进行处理
ActiveSheet.Select
Columns("A:A").Select
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _
Semicolon:=False, Comma:=True, Space:=True, Other:=False, FieldInfo:= _
Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7 _
, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1), Array _
(14, 1)), TrailingMinusNumbers:=True

x3 = Application.CountA(Range("B:B"))
For i = 1 To x3
If Range("B" & i).Value > 1000 Then
Range("B" & i).Value = Range("B" & i).Value / 1024 / 1024 / 1024
End If
Next


'筛选出表1中不重复的值
r = ActiveSheet.Range("A65536").End(xlUp).Row
If r = 1 Then Exit Sub '如果第一列没有数据那么退出程序
Set Dic = CreateObject("scripting.dictionary") '创建字典对象
For i = 1 To r '将第一列数据添加到字典的key值中
Dic(CStr(Cells(i, 1))) = ""
Next
arr = Dic.keys '返回字典key的数组
Set Dic = Nothing '销毁对象
Str = Join(arr, ",")

'下移一行并对第A1单元格赋值
Rows("1:1").Select
Application.CutCopyMode = False
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("A1") = 8

'将所有的数据类型复制到G列的单元格中
x1 = Application.CountA(arr)
For i = 0 To (x1 - 1)
Sheets("Sheet1").Activate
Selection.AutoFilter
ActiveSheet.Range("$A$1:$C$1000").AutoFilter Field:=1, Criteria1:="*" & arr(i) & "*"
Columns("A:D").Select
Selection.Copy
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Paste
Selection.AutoFilter
Rows("1:1").Delete Shift:=xlUp
Rows("1:1").Select
Application.CutCopyMode = False
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("B1").Value = Range("a3").Value
ActiveSheet.Name = "表" & (i + 1)
Next

'复制时间戳到中转表
Sheets("表1").Activate
Range("C:C").Select
Selection.Copy
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Paste
ActiveSheet.Name = "中转表"

'转移筛选好的数据到中转表
For i = 1 To 5
Sheets("表" & i).Select
Range("B:B").Select
Selection.Copy
Sheets("中转表").Activate
x4 = Application.CountA(Rows(3))
Columns(x4 + 1).Select
ActiveSheet.Paste
Next

'创建内存数据表
Sheets("表1").Activate
Range("C:C").Select
Selection.Copy
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Paste
ActiveSheet.Name = "内存"
'创建CPU数据表
Sheets("表1").Activate
Range("C:C").Select
Selection.Copy
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Paste
ActiveSheet.Name = "CPU"


'注入数据
For i = 1 To x1
Sheets("中转表").Activate
c = Cells(1, (i + 1)) Like "*cpu*"

If c = True Then
Columns(i + 1).Select
Selection.Copy
Sheets("CPU").Activate
x4 = Application.CountA(Rows(3))
Columns(x4 + 1).Select
ActiveSheet.Paste

Else
Columns(i + 1).Select
Selection.Copy
Sheets("内存").Activate
x4 = Application.CountA(Rows(3))
Columns(x4 + 1).Select
ActiveSheet.Paste
End If
Next

'处理时间戳
Sheets("内存").Select
x4 = Application.CountA(Columns(1))
x4 = x4 + 1
For i = 2 To x4
Range("A" & i) = (Range("A" & i) + 8 * 3600) / 86400 + 70 * 365 + 19
Range("A" & i).NumberFormatLocal = "[$-F400]h:mm:ss AM/PM"
Range("A" & i).Value = Range("A" & i).Text
Next

Sheets("CPU").Select
x4 = Application.CountA(Columns(1))
x4 = x4 + 1
For i = 2 To x4
Range("A" & i) = (Range("A" & i) + 8 * 3600) / 86400 + 70 * 365 + 19
Range("A" & i).NumberFormatLocal = "[$-F400]h:mm:ss AM/PM"
Range("A" & i).Value = Range("A" & i).Text
Next

'执行画图操作
Sheets("CPU").Select

x2 = Application.CountA(Columns(2))
x3 = Application.CountA(Rows(2))
ActiveSheet.Shapes.AddChart.Select
ActiveChart.ChartType = xlLine
ActiveChart.SetSourceData Source:=Range(Range("B2"), Range(Chr(64 + x3) & x2))
x3 = x3 - 1
For i = 1 To x3
ActiveChart.SeriesCollection(i).Name = "=CPU!$" & Chr(65 + i) & "$1"
Next i
ActiveChart.SeriesCollection(1).XValues = "=CPU!$A$2:$A$" & x2
x3 = x3 + 1
For i = 2 To x3
Dim MEMRange As Range
Set MEMRange = Range(Range(Chr(64 + i) & 2), Range(Chr(64 + i) & x2))

'平均值
Range(Chr(64 + i) & (x2 + 3)).Select
ActiveCell.FormulaR1C1 = "平均值"
Range(Chr(64 + i) & (x2 + 4)).Select
ActiveCell.FormulaR1C1 = Application.WorksheetFunction.Average(MEMRange)

'最大值
Range(Chr(64 + i) & (x2 + 5)).Select
ActiveCell.FormulaR1C1 = "最大值"
Range(Chr(64 + i) & (x2 + 6)).Select
ActiveCell.FormulaR1C1 = Application.WorksheetFunction.Max(MEMRange)

'最小值
Range(Chr(64 + i) & (x2 + 7)).Select
ActiveCell.FormulaR1C1 = "最小值"
Range(Chr(64 + i) & (x2 + 8)).Select
ActiveCell.FormulaR1C1 = Application.WorksheetFunction.Min(MEMRange)

Next i


Sheets("内存").Select

x2 = Application.CountA(Columns(2))
x3 = Application.CountA(Rows(2))
ActiveSheet.Shapes.AddChart.Select
ActiveChart.ChartType = xlLine
ActiveChart.SetSourceData Source:=Range(Range("B2"), Range(Chr(64 + x3) & x2))
x3 = x3 - 1
For i = 1 To x3
ActiveChart.SeriesCollection(i).Name = "=内存!$" & Chr(65 + i) & "$1"
Next i
ActiveChart.SeriesCollection(1).XValues = "=内存!$A$2:$A$" & x2
x3 = x3 + 1
For i = 2 To x3

Set MEMRange = Range(Range(Chr(64 + i) & 2), Range(Chr(64 + i) & x2))

'平均值
Range(Chr(64 + i) & (x2 + 3)).Select
ActiveCell.FormulaR1C1 = "平均值"
Range(Chr(64 + i) & (x2 + 4)).Select
ActiveCell.FormulaR1C1 = Application.WorksheetFunction.Average(MEMRange)

'最大值
Range(Chr(64 + i) & (x2 + 5)).Select
ActiveCell.FormulaR1C1 = "最大值"
Range(Chr(64 + i) & (x2 + 6)).Select
ActiveCell.FormulaR1C1 = Application.WorksheetFunction.Max(MEMRange)

'最小值
Range(Chr(64 + i) & (x2 + 7)).Select
ActiveCell.FormulaR1C1 = "最小值"
Range(Chr(64 + i) & (x2 + 8)).Select
ActiveCell.FormulaR1C1 = Application.WorksheetFunction.Min(MEMRange)

Next i



End Sub

posted @ 2015-05-14 14:20  刘文豪  阅读(1742)  评论(0编辑  收藏  举报