zoukankan      html  css  js  c++  java
  • 第二种自动整理数据生成折线图(相同的功能,差别却这么大)

    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

  • 相关阅读:
    16进制字节和数字转换
    Vs2013 使用EF6 连接mysql数据库
    设计模式-单例模式(Singleton)
    WPF 10天修炼 第十天- WPF数据绑定
    WPF 10天修炼 第九天
    WPF 10天修炼 第八天
    WPF 10天修炼 第七天- WPF资源、样式、控件模板
    WPF 10天修炼 第六天- 系统属性和常用控件
    WPF 10天修炼 第五天- 内容控件
    WPF排版布局经验总结(干货)简短不疲倦
  • 原文地址:https://www.cnblogs.com/liuwenhao/p/4503230.html
Copyright © 2011-2022 走看看