Master3’s blog

LaTeXやExcelVBAなどの作例集

ExcelVBA作例8(UV-Vis:3回測定標準偏差)

  • 前回ご紹介した実験結果の紫外可視吸収スペクトルは、同じサンプルを三回測定していました。
  • このようなデータは、測定値の平均と標準偏差が知りたい場合が多くあります
  • そこで今回は、3回測定の平均と標準偏差を計算するマクロを紹介いたします。
  • このマクロを実行するためには、前回までにご紹介したUV-Visスペクトルを計算するマクロを実行したファイルが必要となりますので、まだの方はそちらの記事を先にご覧になってください。

    master3.hatenablog.com

    master3.hatenablog.com

    前回の記事で作ったExcelファイルをマクロ有効ブックで開きます
  • 次のマクロを実行します

Option Explicit

Sub 三回標準偏差()
    Dim S存在 As Boolean
    S存在 = False
    Dim シート As Worksheet
    For Each シート In Worksheets
        If シート.Name = "3回偏差" Then
            S存在 = True
        End If
    Next
    If S存在 = True Then
        Application.DisplayAlerts = False
        Worksheets("3回偏差").Delete
        Application.DisplayAlerts = True
        S存在 = False
    End If
    If S存在 = False Then
        Worksheets.Add after:=Worksheets(3)
        Worksheets(4).Name = "3回偏差"
    End If
    Worksheets(2).Select
    Dim i As Integer
    i = Range("D2").Value
    Range("A15").Select
    Range(Cells(15, 1), Cells(15, i)).Copy Worksheets(4).Range("A15")
    Worksheets(4).Select
    Dim 列番号 As Integer
    Dim データセット As Integer
    Dim データ番号 As Integer
    データセット = (i - 1) / 3
    列番号 = 2
    For データ番号 = 1 To データセット
        Range(Cells(15, 列番号), Cells(15, 列番号 + 2)).Cut Cells(14 + データ番号, 2)
        列番号 = 列番号 + 3
    Next
    Worksheets(2).Select
    Range(Cells(16, 1), Cells(16, i)).Copy Worksheets(4).Cells(15 + データセット, 1)
    Worksheets(4).Select
    列番号 = 2
    For データ番号 = データセット To データセット * 2
        Range(Cells(15 + データセット, 列番号), Cells(15 + データセット, 列番号 + 2)).Cut Cells(15 + データ番号, 2)
        列番号 = 列番号 + 3
    Next
    Range("E13").Value = "初濃度"
    Range("F14").Value = "平均"
    Range("G14").Value = "標準偏差"
    列番号 = 2
    For データ番号 = 1 To データセット
        Worksheets(2).Cells(17, 列番号).Copy Worksheets(4).Cells(14 + データ番号, 5)
        Worksheets(2).Cells(17, 列番号).Copy Worksheets(4).Cells(14 + データ番号 + データセット, 5)
        列番号 = 列番号 + 3
    Next
    Worksheets(4).Select
    Dim 行番号 As Integer
    For 行番号 = 15 To 14 + データセット * 2
        Cells(行番号, 6).FormulaR1C1 = "=AVERAGE(RC[-4]:RC[-2])"
    Next
    For 行番号 = 15 To 14 + データセット * 2
        Cells(行番号, 7).FormulaR1C1 = "=STDEV.P(RC[-5]:RC[-3])"
    Next
    With ActiveSheet.Shapes.AddChart _
     (xlXYScatter, 20, 40).Chart
     .SetSourceData _
      Range(Cells(14, 5), Cells(14 + データセット, 6))
     .SeriesCollection(1).Trendlines.Add _
        (Type:=xlLinear, Forward:=0, Backward:=0, DisplayEquation:=True, DisplayRSquared:=True).Select
    .HasTitle = True
    .ChartTitle.Text = "吸着等温線"
    .ChartTitle.Font.Size = 11
        With .Axes(xlValue, 1).TickLabels
            .Font.Color = RGB(0, 0, 0) '文字色
            .Font.Size = 12 'サイズ
            .NumberFormatLocal = "0.000" '表示形式
        End With
        With .Axes(xlValue)
            .HasTitle = True
            .AxisTitle.Text = "吸着量"
            .AxisTitle.Orientation = xlVertical
            .MajorTickMark = xlInside '主目盛内側
            .MajorGridlines.Delete '目盛線消去
            .MinorTickMark = xlInside '補助目盛内側
            With .Format.Line
                .Visible = msoTrue
                .ForeColor.ObjectThemeColor = msoThemeColorText1
                .ForeColor.TintAndShade = 0
                .ForeColor.Brightness = 0
                .Transparency = 0
            End With
        End With
        With .Axes(xlCategory).TickLabels
            .Font.Color = RGB(0, 0, 0) '文字色
            .Font.Size = 12 'サイズ
            .NumberFormatLocal = "0.0" '表示形式
        End With
        With .Axes(xlCategory)
            .HasTitle = True
            .AxisTitle.Text = "初濃度"
            .MajorTickMark = xlInside '主目盛内側
            .MinorTickMark = xlInside '補助目盛内側
                With .Format.Line
                    .Visible = msoTrue
                    .ForeColor.ObjectThemeColor = msoThemeColorText1
                    .ForeColor.TintAndShade = 0
                    .ForeColor.Brightness = 0
                    .Transparency = 0
                End With
        End With
        .HasLegend = False                                   '---凡例を非表示
        With .FullSeriesCollection(1) '項目1の設定
            .HasErrorBars = True 'エラーバーを表示
            .ErrorBar Direction:=xlY, Include:=xlBoth, Type:=xlCustom, _
            Amount:=Range(Cells(15, 7), Cells(14 + データセット, 7)), MinusValues:=Range(Cells(15, 7), Cells(14 + データセット, 7)) 'エラーバーの設定
            .ErrorBar Direction:=xlX, _
                      Include:=xlBoth, _
                      Type:=xlErrorBarTypeCustom, _
                      Amount:=0, _
                      MinusValues:=0
        End With
    End With
    ActiveChart.PlotArea.Select
    With Selection.Format.Line
        .Visible = msoTrue
        .ForeColor.ObjectThemeColor = msoThemeColorText1
        .ForeColor.TintAndShade = 0
        .ForeColor.Brightness = 0
        .Transparency = 0
    End With
    With ActiveSheet.ChartObjects(1).Chart.SeriesCollection(1)
        'マーカーの背景色
        .MarkerBackgroundColorIndex = xlColorIndexNone '赤
    End With
    '1つ目の系列
    With ActiveSheet.ChartObjects(1).Chart.SeriesCollection(1)
        .MarkerSize = 8 'マーカーのサイズ
    End With
    '1つ目の系列
    With ActiveSheet.ChartObjects(1).Chart.SeriesCollection(1)
        .MarkerStyle = 8 'マーカーを表示(種類:1~9)
    End With
End Sub