Master3’s blog

LaTeXやExcelVBAなどの作例集

ExcelVBA作例9(UV-Vis:経時変化)

  • 今回ご紹介するのは、前回までにご紹介した、3回ずつ測定したUV-Visスペクトルから計算した濃度の、平均値と標準偏差の時間変化を集計するマクロになります。
  • このマクロを実行するためには、前回までにご紹介した3回平均と標準偏差を計算するマクロを実行したファイルが必要となりますので、まだの方はそちらの記事を先にご覧になってください。

    master3.hatenablog.com

    master3.hatenablog.com

    master3.hatenablog.com

    f:id:Master3:20220325053957p:plain

    データがそろうとこんな感じ

    f:id:Master3:20220325054539p:plain

    今回はデータが二つだけなのでこんな感じ
  • まずはこの記事のシリーズの最初でご紹介した検量線を作成するマクロを実行したExcelファイルで、前回の記事でご紹介した3回平均と標準偏差のマクロを実行します
  • このファイルは上書き保存をして閉じます
  • 新しいExcelブックを開きます。
  • 下のマクロを実行します

Option Explicit

Sub 濃度変化()
    With Application.FileDialog(msoFileDialogOpen)
        .InitialFileName = ActiveWorkbook.Path
        .FilterIndex = 2
        If .Show = -1 Then
            .Execute
        Else: GoTo L1
        End If
    End With
    Dim i As Integer
    Dim 列番号 As Integer
    Dim データセット As Integer
    Dim データ番号 As Integer
    Dim ブック As Workbook
    列番号 = 5
    Workbooks(2).Activate
    Worksheets(4).Select
    Range("E15", Range("E15").End(xlDown)).Copy Workbooks(1).Worksheets(1).Range("E4")
    For Each ブック In Workbooks
        If Not (ブック Is Workbooks(1)) Then
            ブック.Activate
            Worksheets(2).Select
            i = Range("D2").Value
            Worksheets(4).Select
            データセット = (i - 1) / 3
            Range(Cells(15 + データセット, 6), Cells(14 + データセット + データセット, 6)).Copy
            Workbooks(1).Activate
            Worksheets(1).Select
            Range(Cells(4, 列番号), Cells(3 + データセット, 列番号)).PasteSpecial xlPasteValues
            ブック.Activate
            Worksheets(1).Select
            Range("E1").Copy Workbooks(1).Worksheets(1).Cells(3, 列番号)
            ブック.Activate
            Worksheets(4).Select
            Range(Cells(15 + データセット, 7), Cells(14 + データセット + データセット, 7)).Copy
            Workbooks(1).Activate
            Worksheets(1).Select
            Range(Cells(4 + データセット, 列番号), Cells(3 + データセット + データセット, 列番号)).PasteSpecial xlPasteValues
            ブック.Activate
            ブック.Close savechanges:=False
        End If
        列番号 = 列番号 + 1
    Next
    GoTo L2
    
L1:
    Range("F4").CurrentRegion.Select
    列番号 = Range("F4").CurrentRegion(Range("F4").CurrentRegion.Count).Column
    データセット = (Range("F4").CurrentRegion(Range("F4").CurrentRegion.Count).Row - 3) / 2
    GoTo L2
    Exit Sub
    
L2:
    Dim G存在 As Boolean
    G存在 = False
    Dim シート As Worksheet
    For Each シート In Worksheets
        If シート.Name = "グラフ" Then
            G存在 = True
        End If
    Next
    If G存在 = True Then
        Application.DisplayAlerts = False
        Worksheets("グラフ").Delete
        Application.DisplayAlerts = True
        G存在 = False
    End If
    If G存在 = False Then
        Worksheets.Add after:=Worksheets(1)
        Worksheets(2).Name = "グラフ"
    End If
    Worksheets(1).Select
    Worksheets(1).Range(Cells(3, 5), Cells(3 + データセット + データセット, 列番号)).Copy
    Worksheets(2).Select
    ActiveSheet.Paste Range("E3")
    Worksheets("グラフ").Select
    With ActiveSheet.Shapes.AddChart _
     (xlLine, 200, 400).Chart
     .SetSourceData _
      Range(Cells(3, 5), Cells(3 + データセット, 列番号))
    .HasTitle = True
    .ChartTitle.Text = "経時変化"
    .ChartTitle.Font.Size = 11
        With .Axes(xlValue, 1).TickLabels
            .Font.Color = RGB(0, 0, 0) '文字色
            .Font.Size = 12 'サイズ
            .NumberFormatLocal = "0.0" '表示形式
        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                                   '---凡例を非表示
      Select Case .PlotBy
        Case xlRows
          .PlotBy = xlColumns
        Case xlColumns
          .PlotBy = xlRows
      End Select
    For データ番号 = 1 To データセット
        With .FullSeriesCollection(データ番号) '項目1の設定
            .HasErrorBars = True 'エラーバーを表示
            .ErrorBar Direction:=xlY, Include:=xlBoth, Type:=xlCustom, _
            Amount:=Range(Cells(3 + データ番号 + データセット, 6), Cells(3 + データ番号 + データセット, 列番号)), MinusValues:=Range(Cells(3 + データ番号 + データセット, 6), Cells(3 + データ番号 + データセット, 列番号)) 'エラーバーの設定
        End With
    Next
    End With
    MsgBox "完了"
    Exit Sub
End Sub

 

  • 前回までに作った、2つのファイルを同時選択して開く

    f:id:Master3:20220325055511p:plain

    うまくいけば、このようなメッセージボックスが表示されます
  • 「グラフ」シートをスクロールすると、グラフが現れます

    f:id:Master3:20220325055649p:plain

    以上です
  • うまくいかないときは、選択するそれぞれのブックに、spectrumと三回偏差を含む4つのシートが作られているかを確認してみてください
  • 最後までお読みいただきありがとうございます!