[原创]：一个简单的Grapher自动化脚本

holz

'=======================================================================================
'文件：获取正常场.bas
'功能：通过不断剔除局部异常数据的方式，求得正常场数值，也可以说是区域异常。
'作者：何门贵（hemengui@gmail.com）
'日期：2005.01.18
'要求：Sax Basic 3.0 以及 Golden Software Grapher 4
'局限：仅考虑二列数据，如果有多列数据，需进行修改；完全没有防错语句，遇到错误不要被吓坏了找我。
'致谢：写出 Grapher 4 这样的程序的那帮家伙们！
'声明：凡使用本脚本导致饭烧焦、菜煮坏、电脑黑屏、被黑客攻击、被病毒破坏，以及等等事情，一概不承担责任。
'========================================================================================

Option Explicit

Sub Main
        Dim GrapherApp As Object  '应用程序对象
        Dim Plot As Object        '图形文档对象
        Dim Shapes As Object      '形状集合，所有图形对象基于此
        Dim Graph As Object       '图表对象
        Dim LinePlot As Object    '折线/散点图对象
        Dim Wks As Object         '工作表文档对象
        Dim WksRange As Object    '选择范围
        Dim wksStats As Object    '统计内容

        Dim inFileName As String  '输入文件名
        Dim ouFileName As String  '输出文件名
        Dim sngMean As Single     '通过统计求得的平均值，最终为需要的正常场值
        Dim sngSTD As Single      '标准偏差、标准离差……
        Dim lCount As Long        '记录数据的个数
        Dim lStartRow As Long     '开始的行
        Dim lEndRow As Long       '结束的行

        Dim i As Long             '一个循环变量
        Dim bCanClip As Boolean   '记录是否可以进一步剔除异常数据

        Set GrapherApp=CreateObject("Grapher.Application")   '在内存中创建一个Grapher实例。
        Debug.Clear  '清除Scripter中的立即窗口垃圾，以免影响视听。

        inFileName=GetFilePath("*.dat;*.xls;*.txt",,,"Select a data file",4)  '调用对话框选择数据文件。
        If inFileName="" Then End   '没有找到数据文件？我不玩了。
        bCanClip=True    '假设原始数据中存在可剔除的突变数据。
        Set Wks=GrapherApp.Documents.Open(inFileName)     '用工作表打开刚才选择的这个数据文件。

While(bCanClip=True)   '循环开始了
        Set WksRange=Wks.Columns("B")   '选择B列。
        Set wksStats=WksRange.Statistics(True,True,wksStatsMean)  '统计平均值。
        Debug.Print "Mean : " & wksStats.Mean   '到立即窗口Show一下。
        sngMean=wksStats.Mean   '赶紧将这个均值用一个变量保存起来。
        Set wksStats=WksRange.Statistics(True,True,wksStatsStandardDeviation)   '统计标准偏差。
        Debug.Print "Standard Deviation : " & wksStats.StandardDeviation   '也Show一下。
        sngSTD=wksStats.StandardDeviation   '还是要保存起来，免得忘记了。
        Set wksStats=WksRange.Statistics(True,True,wksStatsCount)   '对了，还要一个数据个数。
        lCount=wksStats.Count   '数据个数就不显示了，只要保存起来就好，以备后用。
        Set WksRange=Wks.Columns("A:B")   '将全部的两列数据都选中，什么？你有三列数据？你就改罢。
        WksRange.Sort(2,wksSortAscending,1,wksSortAscending,,,True)   '排排坐，吃果果，按数值的升序排列。

        lStartRow=-999  '有负数的行吗？
        lEndRow=-999    '显然没有。
        bCanClip=False  '统计了一遍，假设不能剔除了。
        For i=2 To lCount+1   '全部数据循环一下，这时最笨的办法，不过很容易明白。
           If Val(Wks.Cells(i,2).Value)>(sngMean+3*sngSTD) Then   '如果发现了超过限制的，那就干活。
              Debug.Print Wks.Cells(i,2).Value
              lStartRow=i
              lEndRow=lCount+1
              bCanClip=True
              Exit For
           End If
        Next i
        If lStartRow>0 And lEndRow>0 And lStartRow<lEndRow Then  '将那些突变数据全部剔除。
           Set WksRange=Wks.Rows(lStartRow,lEndRow)
           WksRange.Delete(wksDeleteRows)
        End If

        lCount=lEndRow-lStartRow   '再来就重复上面的，不过上面看上限，这里看下限。
        lStartRow=-999
        lEndRow=-999
        For i=2 To lCount
           If Val(Wks.Cells(i,2).Value)<(sngMean-3*sngSTD) Then
              Debug.Print Wks.Cells(i-1,2).Value
              lStartRow=2
              lEndRow=i
              bCanClip=True
           End If
        Next i
        If lStartRow>0 And lEndRow>0 And lStartRow<lEndRow Then
           Set WksRange=Wks.Rows(lStartRow,lEndRow)
           WksRange.Delete(wksDeleteRows)
        End If
Wend  '循环结束，为什么结束？因为剔到不能再剔了。

        Set WksRange=Wks.Columns("B")   '再次选择第二列数据。
        Set wksStats=WksRange.Statistics(True,True,wksStatsMean)  '检查一下各项统计先。
        sngMean=wksStats.Mean
        Set wksStats=WksRange.Statistics(True,True,wksStatsStandardDeviation)
        sngSTD=wksStats.StandardDeviation
        Wks.Close(grfSaveChangesNo)     '记得刚才已经将原始数据整的乱七八糟了吗？所以现在就不保存。
        Set Wks=GrapherApp.Documents.Open(inFileName)   '再次打开。
        Set WksRange=Wks.Columns("B")   '检查原始数据个数。
        Set wksStats=WksRange.Statistics(True,True,wksStatsCount)
        lCount=wksStats.Count

        Wks.Cells("C1").Value="Mean"   '第三列第一行，写标题
        Wks.Cells("D1").Value="Upper"  '第四列第一行，写标题
        Wks.Cells("E1").Value="Lower"  '第五列第一行，写标题
        Wks.Cells("C2").Value=sngMean              '第三列第二行，写入正常场数值。
        Wks.Cells(lCount+1,3).Value=sngMean        '到本列最后一个单元格，再次写一个。
        Wks.Cells("D2").Value=sngMean+3*sngSTD
        Wks.Cells(lCount+1,4).Value=sngMean+3*sngSTD
        Wks.Cells("E2").Value=sngMean-3*sngSTD
        Wks.Cells(lCount+1,5).Value=sngMean-3*sngSTD
        ouFileName=Left(inFileName,Len(inFileName)-4) & "_处理.dat"   '选择一个输出文件名。
        Debug.Print ouFileName        '检查一下这个文件名是否正确。
        Wks.SaveAs(ouFileName)        '将刚才的处理结果保存为一个新文件。
        Wks.Close(grfSaveChangesNo)   '关闭工作表。

        Set Plot=GrapherApp.Documents.Add(grfPlotDoc)   '轮到图形上场了，先新建一个图形文档。
        Plot.Windows(1).AutoRedraw=False                '将这个图形窗口的自动刷新禁止，为什么？一切为了速度！
        Set Shapes=Plot.Shapes                          '先Shapes一下，免得后面打字辛苦。

        Set Graph=Shapes.AddLinePlotGraph(ouFileName,1,2,"My Demo Graph")   '先用原始数据画一个折线/散点图。
        Set LinePlot=Graph.AddLinePlot(ouFileName,1,3,"Mean Level")         '再画一个正常水平线。
        LinePlot.line.style="Solid"              '这条线，用实线罢。
        LinePlot.line.foreColor=grfColorBlue     '这条线，用蓝色罢。
        LinePlot.Clipping.Continuous = True      '这条线，用连续画法罢，（不愿意？你试试？）
        Set LinePlot=Graph.AddLinePlot(ouFileName,1,4,"Upper Level")        '再来画一个上限水平罢。
        LinePlot.line.style=".1 in. Dash"        '这次用虚线罢。
        LinePlot.line.foreColor=grfColorRed      '这次改用红色罢。
        LinePlot.Clipping.Continuous = True      '不过还是要用连续画法哦。
        Set LinePlot=Graph.AddLinePlot(ouFileName,1,5,"Lower Level")        '最后来画一个下限了罢。
        LinePlot.line.style=".1 in. Dash"
        LinePlot.line.foreColor=grfColorRed
        LinePlot.Clipping.Continuous = True

    '我们要不要给图形增加一些说明？例如告诉别人这里的正常场是多少？上下限多少？那我们就用图表标题好了，最简单。
        Graph.title.text="              Mean : " & sngMean & vbCrLf & _
                         "Standard Deviation : " & sngSTD & vbCrLf & _
                         "       Upper Limit : " & sngMean + 3*sngSTD & vbCrLf & _
                         "       Lower Limit : " & sngMean-3*sngSTD & vbCrLf & vbCrLf & _
                         "Written by Holz (hemengui@gmail.com)"
        Graph.title.Font.face="Courier new"     '选择一个喜欢的字体。
        Graph.title.Font.size=18                '设置一个喜欢的大小。
        Graph.title.Font.color=grfColorOrange   '选择一个中意的颜色。
        Graph.title.Font.Bold=True              '添加一个想要的风格。

        GrapherApp.WindowState(grfWindowStateMaximized)   '所有工作完成，将主窗口最大化。
        GrapherApp.ActiveWindow.WindowState(grfWindowStateMaximized)   '将图形文档最大化，好多看一些。
        Plot.Windows(1).AutoRedraw=True          '重新打开自动刷新。你不想老按F5罢？
        Plot.Windows(1).zoom(grfZoomFitToWindow) '将图形缩放到一个适当的大小，方便近视眼观看。
        GrapherApp.Visible=True      '将这个Grapher主窗口显示出来，难道你不想看看结果吗？

        'If MsgBox("Mean : " & sngMean & vbCrLf & "Standard deviation : " & sngSTD & vbCrLf & vbCrLf & _
        '          "Number of Value : " & lCount & vbCrLf & vbCrLf & _
        '          "Discard the change and quit the Grapher?" ,vbInformation + vbYesNo,"Confirm")=vbYes Then
        '   Plot.Close(grfSaveChangesNo)
        '   GrapherApp.Quit
        'End If
End Sub