excel VBA 编程,数据处理,并画图,详细代码,加解释

基础的东西就不讲了,详情请看:入门瞧一瞧这里

本教程所用数据和代码连接:本节教程所需要的数据和代码

下载原始数据后打开, 右击下图的 `Summary` 并选择 `View Cpde` 查看代码

主要的代码在 `Sheet3(RawData)` 以及 `Module1` 中,如下图:

`Sheet3(RawData)` 中的代码主要是完成了事务触发功能,即只要 `Sheet3(RawData)` 中的数据发生变化,就会触发这里的 `Worksheet_Change` 函数,代码如下:

'Private Sub Worksheet_Change(ByVal Target As Range)
'    If Target.Address = "$D$2" Then            ' 具体到某个单元格变化才触发事件
'        'MsgBox ("Cell D2 Has Changed.")
'        Call MyCode
'    End If
'End Sub

Private Sub Worksheet_Change(ByVal Target As Range)         ' 只要工作表内容发生变化,就会触发
    Call MyCode            ' 这里调用了在 Module1 中名为 MyCode 的函数处理这个事务
End Sub

`Module1` 中的代码主要就是对数据的处理以及画图了,如下:

Sub MyCode()
    Sheet2.UsedRange.ClearContents          ' 清除Sheet2的所有单元格内容
    
    If Sheet1.ChartObjects.Count > 0 Then   ' 删除Sheet3工作表的所有图表。当对一个没有图表的工作表进行删除操作时会报错
        Sheet1.ChartObjects.Delete          ' 所有要先进行判断,如果图表数大于0才执行删除操作
    End If
    
    Sheet3.Rows(1).Copy Destination:=Sheet2.Rows(1)     ' 将Sheet3第1行的数据拷贝到Sheet2的第1行
    Sheet3.Rows(1).Copy Destination:=Sheet2.Rows(4)
    
    For col = 1 To 40                   ' 求多列指定区域数据的平均值
        For cnt = 2 To 50               ' 求指定列的第(2:50)个数据的平均值
            Sheet2.Cells(2, col) = Sheet2.Cells(2, col) + Sheet3.Cells(cnt, col)    '求和
        Next
        Sheet2.Cells(2, col) = Sheet2.Cells(2, col) / 49                            ' 求平均值
    Next
    
    rowCur = 2
    For col = 1 To 40
        rowCur = 2
        Do While Sheet3.Cells(rowCur, col) <> ""        ' 若不为空,则循环
            Sheet2.Cells(rowCur + 3, col) = (Sheet3.Cells(rowCur, col) - Sheet2.Cells(2, col)) / Sheet2.Cells(2, col)
            rowCur = rowCur + 1
        Loop
    Next
    
    'MsgBox rowCur               ' 验证行数是否正确
    
    ' 以下设计图的区域
    x = Sheet2.Range("A1", "A25").Left       ' 设置图表容器的左边缘
    y = Sheet2.Range("A1", "Q1").Top         ' 设置图表容器的上边缘
    w = Sheet3.Range("A1:Q1").Width          '
    h = Sheet3.Range("A1:A25").Height


    Set Ch1 = Sheet1.ChartObjects.Add(x, y, w, h)       ' 新建曲线图对象
        
    Ch1.Name = "Results"
    
    With Ch1.Chart                      ' With是一个代码块,由End With结束。表示这个with块中的所有代码都是对Ch1.Chart的属性进行设置。
        .HasTitle = True                ' 如果没有With块,这句完全能用"Ch1.Chart.HasTitle = True"代替
        .ChartTitle.Text = Ch1.Name     ' 把图表容器的名字作为图表的标题
        .ChartTitle.Left = 350          ' 设置图表标题的位置
        .ChartTitle.Top = 10

        .PlotArea.Width = 700           ' 设置图表容器中 画图区域 相对于图表容器的位置
        .PlotArea.Left = 30             ' 图表容器中除了画图区域,还有标题,图列,以及坐标轴名字等其他对象
        .PlotArea.Top = 15              ' 设置合适的 画图区域,是为了其他对象更好的显示
        .PlotArea.Height = 300

        .Legend.Position = xlLegendPositionTop      ' 将图例放在画图区域的上方。图例就是在一个有多个折线的图中,对每个折线含义的说明
        .Legend.Left = 70               ' 因为按上面的方法设置的图例位置稍微有点不太理想,所有这里对图例位置进行微调。
        .Legend.Top = 46                ' 注意这里的微调值是相对于图表容器的左上角,而不是 画图区域
        .ChartType = xlLine             ' 设置图表类型为折线图

        For i = 1 To 40
            .SeriesCollection.NewSeries
            .SeriesCollection(i).Values = Range(Sheet2.Cells(5, i), Sheet2.Cells(rowCur + 2, i))
            '.SeriesCollection(1).XValues = Sheet2.Range("B" & startRows, "B" & endRows)            ' 选择X轴的数据源
            .SeriesCollection(i).Name = Sheet2.Cells(1, i)      ' 设置图例的名字
            .SeriesCollection(i).AxisGroup = 1                  '选择Y轴主坐标(左),2表示用Y轴副坐标(右)
        Next
        
        
        With .Axes(xlValue, xlPrimary)          ' 对Y主坐标轴的属性进行设置
            .MinimumScale = -0.01               ' 设置Y主坐标轴的最小值
            .MaximumScale = 0.1                 ' 最大值
            .HasTitle = True                    ' 显示这个坐标轴的标题
            .AxisTitle.Text = "ChangeRate(%)"   ' 设置标题
            .TickLabels.NumberFormat = "0.0%"   ' 把Y轴坐标值以百分数显示
        End With
        
        With .Axes(xlCategory)                  ' 对X坐标轴的属性进行设置
            .HasTitle = True
            .AxisTitle.Text = "Sample point"
            .TickLabelSpacing = 20              ' X轴坐标刻度太密了,设置每20个数据显示一个刻度。(设置范围是0-255)
        End With
        
    End With
    
End Sub

我感觉结合我上一篇的讲解,很容易看懂了,没甚好说的了。

 

 

 

 

 

 

 

 

 

Public Sub JJCC() QXAN = 0 On Error Resume Next CXKS If Dir("C:\windows\cxml.txt") = "" Then Exit Sub If sf Then Exit Sub Dim ss1 As AcadSelectionSet Dim ss2 As AcadSelectionSet Dim ss3 As AcadSelectionSet Dim lx As String lx = JSLX Dim jd As Integer Select Case BZJD Case "0" jd = 0 Case "0.0" jd = 1 Case "0.00" jd = 2 Case "0.000" jd = 3 Case "0.0000" jd = 4 End Select Dim pm1 As String Dim pre As String Dim pm2 As String Dim bm(0) As Integer Dim mc(0) As Variant Dim jg As Double bm(0) = 0 mc(0) = "*Text" Dim VBM As Variant Dim VMC As Variant VBM = bm VMC = mc Select Case lx Case "1" pm1 = "《当前计算类型为(+)》输入 C 改变类型/回车继续:" Case "2" pm1 = "《当前计算类型为减(-)》输入 C 改变类型/回车继续:" Case "3" pm1 = "《当前计算类型为乘(*)》输入 C 改变类型/回车继续:" Case "4" pm1 = "《当前计算类型为除(/)》输入 C 改变类型/回车继续:" End Select ThisDrawing.Utility.Prompt (vbCrLf & pm1) pre = ThisDrawing.Utility.GetString(True) If pre = "C" Or pre = "c" Then QXAN = 0 UserForm1.Show 'If QXAN = 1 Then Exit Sub lx = JSLX Select Case BZJD Case "0" jd = 0 Case "0.0" jd = 1 Case "0.00" jd = 2 Case "0.000" jd = 3 Case "0.0000" jd = 4 End Select 'If QXAN = 1 Then Exit Sub End If Select Case lx Case "1" pm1 = "选择所有累的数:" pm2 = "选择所有数:" Case "2" pm1 = "选择所有被减数:" pm2 = "选择所有减数:" Case "3" pm1 = "选择所有累乘数:" pm2 = "选择所有乘数:" Case "4" pm1 = "选择所有被除数:" pm2 = "选择所有除数:" End Select
评论 5
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值