Excelのvbaで一日ごとのデータグラフを描写したい。

Question

実現したいこと

・二つのデータの折れ線グラフを作成したい。(横軸;日時、縦軸;計測値)
・全部のデータを利用したブラフを作成する(横軸;測定した日時すべて、縦軸;対応する測定値)
・一日毎のデータグラフを個別(データごと)に作成する。(横軸;一日分の測定時間、縦軸;対応する測定値)
・グラフタイトルを、測定した日付or測定開始から何日目で表示したい。

前提

Excelのvbaを利用して、自動で測定したデータからグラフを作成できるようにしたい。データロガーを作成し、一週間ほど、水温と圧力のデータを取得しています。これを、csvファイルにて保存し、excelファイルで読み込みを行い、測定期間全体のグラフと、一日毎のグラフを水温と圧力を別々で表示できるようにしたいです。現在、測定期間全体のグラフを描写するところまではできたのですが、一日毎のグラフにするところで躓いています。
chat gptを活用してプログラムを修正した結果、どんどん悪化してしまったので助けてほしいです。

実装を予定しているcsvファイルは、C列に日時データ、D列に水温、E列に圧力データが格納されています。
イメージですが、下記のようなファイル構造です。

カウント| 時間| 日時 |水温|圧力
0 | 0 |2023/5/31/12;00| 23 |1013
1 | 10 |2023/5/31/12;10| 23 |1013
2 | 20 |2023/5/31/12;20| 22 |1014

発生している問題・エラーメッセージ

一日毎のデータグラフになっていません。
エラーメッセージこそ発生していないですが、作成されたグラフが全く違うところのデータを参照しています。
また、一つのグラフに水温・圧力のデータをまとめてグラフにされてしまうのですが、別々にグラフを作ってほしいです。

該当のソースコード

ソース

Sub graf_drow_day()
    '変数の型を宣言
    Dim x_ax As Range
    Dim y_ax1 As Range
    Dim y_ax2 As Range
    Dim x_title As String
    Dim y_title As String
    Dim GRF_name As String
    
    'ワークシートを取得する
    Dim ws As Worksheet
    Set ws = ActiveSheet
    
    'データ範囲を指定する
    Dim lastRow As Long
    lastRow = ws.Cells(ws.Rows.Count, 3).End(xlUp).Row
    Set x_ax = ws.Range("C2:C" & lastRow)
    Set y_ax1 = ws.Range("D2:D" & lastRow)
    Set y_ax2 = ws.Range("E2:E" & lastRow)
    
    '横軸縦軸の名前を指定する
    x_title = "Date"
    y_title = "Value"
    
    '横軸縦軸の文字サイズを指定する
    Dim ax_fontsize As Integer
    ax_fontsize = 14
    
    'グラフ作成のための変数を宣言する
    Dim startDate As Date
    Dim endDate As Date
    Dim currentDate As Date
    Dim chartIndex As Integer
    
    'グラフ作成の開始日と終了日を設定する
    startDate = WorksheetFunction.Min(x_ax)
    endDate = WorksheetFunction.Max(x_ax)
    
    '日ごとのグラフを作成する
    currentDate = startDate
    chartIndex = 1
    
    Do While currentDate <= endDate
        'グラフのタイトルを指定する
        GRF_name = "daily-graf (" & Format(currentDate, "yyyy/mm/dd") & ")"
        
        '日付に対応するデータを抽出する
        Dim rngX As Range
        Dim rngY1 As Range
        Dim rngY2 As Range
        Set rngX = x_ax.Cells.Find(What:=currentDate, LookIn:=xlValues, LookAt:=xlWhole)
        If Not rngX Is Nothing Then
            Set rngY1 = y_ax1.Cells(rngX.Row - y_ax1.Row + 1)
            Set rngY2 = y_ax2.Cells(rngX.Row - y_ax2.Row + 1)
            
            'グラフを挿入する
            Dim chart As Shape
            Set chart = ws.Shapes.AddChart2(240, xlXYScatter)
            chart.Name = "Chart" & chartIndex
            
            With chart.chart
            
                '指定したデータでグラフ作成
                .SeriesCollection.NewSeries
                .SeriesCollection(1).XValues = rngX
                .SeriesCollection(1).Values = rngY1
                
                'グラフの名前、タイトル、軸を変更する
                .HasTitle = True
                .ChartTitle.Text = GRF_name
                .Axes(xlCategory, xlPrimary).HasTitle = True
                .Axes(xlCategory, xlPrimary).AxisTitle.Text = x_title
                .Axes(xlValue, xlPrimary).HasTitle = True
                .Axes(xlValue, xlPrimary).AxisTitle.Text = y_title
                .Axes(xlCategory).AxisTitle.Format.TextFrame2.TextRange.Font.Size = ax_fontsize
                .Axes(xlValue).AxisTitle.Format.TextFrame2.TextRange.Font.Size = ax_fontsize
                                
                
                '2つ目のデータ系列を追加する
                .SeriesCollection.NewSeries
                .SeriesCollection(2).XValues = rngX
                .SeriesCollection(2).Values = rngY2
                
                '系列2のグラフの種類を折れ線グラフに設定する
                .SeriesCollection(2).ChartType = xlLine
                
                '系列2のデータポイントにマーカーを表示する
                .SeriesCollection(2).MarkerStyle = -4142 'xlMarkerStyleNone
                
                'グラフの範囲を自動調整する
                .AutoScaling = True
            End With
            
            '次の日に進む
            currentDate = currentDate + 1
            chartIndex = chartIndex + 1
        Else
            '次の日に進む
            currentDate = currentDate + 1
        End If
    Loop
End Sub

試したこと

For文の範囲を、diffに+1して、繰り返し回数を正常化しました。
diffをprintで表示して、日付計算の確認
グラフ描写範囲や、二つ目のグラフ表示の書き方や範囲指定方法を、for文の中に入れたり、指定方法を変えたりしたのですが、構文エラーや処理落ちをしてしまいました。また、一つのグラフに二つのデータが入る問題が解決できませんでした。

Comments

[kikukiku]

デバック実行で１行つづ確認し、
どの行から想定と違う動作をするか突き止めてください。
突き止めた結果を質問に追記すると、回答が得られやすくなると思います。

[kanakann]

コメントありがとうございます。
日時データの抽出までは正常にできているのですが、その下のグラフ描写ができていない形になっております。一日ごとのデータでグラフを描写したいのですが、一日ではなく単一データor全データでグラフを描写してしまい、まったく同じグラフが生成される結果となっております

Answer 1

一日毎のグラフを水温と圧力を別々で表示

次のようなマクロを実行なさりたい、ということでしょうか。

Sub AddChartObjectsByDate()

    Const TableTopLeftCellAddress As String = "A1"
    Const TableColumnsCount As Long = 5

    Const MeasurementDateColumn As Long = 3
    Const TemperatureColumn As Long = 4
    Const PressureColumn As Long = 5

    Dim wsSource As Excel.Worksheet
    Dim rngTopLeftCell As Excel.Range
    Dim rngSource As Excel.Range
    Dim lngHeaderRow As Long
    Dim lngLastColumn As Long
    Dim lngFirstDataRow As Long
    Dim lngLastDataRow As Long
    Dim dblMinimumTemperature As Double
    Dim dblMaximumTemperature As Double
    Dim dblMinimumPressure As Double
    Dim dblMaximumPressure As Double

    Set wsSource = ActiveSheet

    With wsSource
        
        Set rngTopLeftCell = .Range(TableTopLeftCellAddress)
        
        lngHeaderRow = rngTopLeftCell.Row
        lngLastColumn = rngTopLeftCell.Offset(0, TableColumnsCount - 1).Column
        
        lngFirstDataRow = lngHeaderRow + 1
        lngLastDataRow = .Cells(.Rows.Count, rngTopLeftCell.Column).End(xlUp).Row
        
        If lngLastDataRow < lngFirstDataRow Then
            Set wsSource = Nothing
            Exit Sub
        End If
        
        If .AutoFilterMode = True Then
            .AutoFilter.ShowAllData
            .AutoFilterMode = False
        End If
        
        Set rngSource = .Range(rngTopLeftCell, _
                               .Cells(lngLastDataRow, lngLastColumn))
        
        rngSource.AutoFilter
        
        With .AutoFilter.Sort
            .SortFields.Clear
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortFields.Add2 Key:=rngSource.Columns(MeasurementDateColumn), _
                             SortOn:=xlSortOnValues, _
                             Order:=xlAscending, _
                             DataOption:=xlSortNormal
            .Apply
        End With
        
    End With

    With rngSource
        dblMinimumTemperature = WorksheetFunction.Min(.Columns(TemperatureColumn))
        dblMaximumTemperature = WorksheetFunction.Max(.Columns(TemperatureColumn))
        dblMinimumPressure = WorksheetFunction.Min(.Columns(PressureColumn))
        dblMaximumPressure = WorksheetFunction.Max(.Columns(PressureColumn))
    End With

    Dim chartObjectNew As Excel.ChartObject
    Dim chartTarget As Excel.chart
    Dim seriesTarget As Excel.Series
    Dim axisTarget As Excel.Axis
    Dim rngTargetCell As Excel.Range
    Dim rngXValues As Excel.Range
    Dim rngYValues1 As Excel.Range
    Dim rngYValues2 As Excel.Range
    Dim lngRow As Long
    Dim lngPlotStartRow As Long
    Dim lngPlotEndRow As Long
    Dim lngChartLeft As Long
    Dim lngChartTop As Long
    Dim lngChartWidth As Long
    Dim lngChartHeight As Long
    Dim dateCurrent As Date

    lngPlotStartRow = 2
    lngPlotEndRow = lngPlotStartRow

    With wsSource.Cells(lngHeaderRow, lngLastColumn + 2)
        lngChartLeft = .Left
        lngChartTop = .Top
        lngChartWidth = 640
        lngChartHeight = 480
    End With

    Application.ScreenUpdating = False

    If wsSource.ChartObjects.Count > 0 Then
        wsSource.ChartObjects.Delete
    End If

    For lngRow = 2 To rngSource.Rows.Count
        Set rngTargetCell = rngSource.Cells(lngRow, MeasurementDateColumn)
        If Format(rngTargetCell.Value, "yyyy/mm/dd") <> Format(rngTargetCell.Offset(1, 0).Value, "yyyy/mm/dd") Then
            
            dateCurrent = Format(rngTargetCell.Value, "yyyy/mm/dd")
            lngPlotEndRow = lngRow
            
            With rngSource
                Set rngXValues = wsSource.Range(.Cells(lngPlotStartRow, MeasurementDateColumn), _
                                                .Cells(lngPlotEndRow, MeasurementDateColumn))
                Set rngYValues1 = wsSource.Range(.Cells(lngPlotStartRow, TemperatureColumn), _
                                                 .Cells(lngPlotEndRow, TemperatureColumn))
                Set rngYValues2 = wsSource.Range(.Cells(lngPlotStartRow, PressureColumn), _
                                                 .Cells(lngPlotEndRow, PressureColumn))
            End With
            
            Set chartObjectNew = wsSource.ChartObjects.Add(lngChartLeft, lngChartTop, lngChartWidth, lngChartHeight)
            Set chartTarget = chartObjectNew.chart
                            
            With chartTarget
                .HasTitle = True
                .ChartTitle.Text = "daily-graph (" & Format(dateCurrent, "yyyy/mm/dd") & ")"
                .HasLegend = True
                .Legend.Position = xlLegendPositionBottom
            End With
            
            Set seriesTarget = chartTarget.SeriesCollection.NewSeries
            With seriesTarget
                .ChartType = xlXYScatterLinesNoMarkers
                .AxisGroup = xlPrimary
                .Name = rngSource.Cells(1, TemperatureColumn)
                .XValues = rngXValues
                .Values = rngYValues1
                .Format.Line.Weight = 1
            End With
            Set seriesTarget = Nothing
            
            Set seriesTarget = chartTarget.SeriesCollection.NewSeries
            With seriesTarget
                .ChartType = xlXYScatterLinesNoMarkers
                .AxisGroup = xlSecondary
                .Name = rngSource.Cells(1, PressureColumn)
                .XValues = rngXValues
                .Values = rngYValues2
                .Format.Line.Weight = 1
            End With
            Set seriesTarget = Nothing
            
            chartTarget.SetElement msoElementPrimaryCategoryAxisShow
            chartTarget.SetElement msoElementPrimaryCategoryGridLinesMajor
            Set axisTarget = chartTarget.Axes(xlCategory, xlPrimary)
            With axisTarget
                .HasTitle = True
                With .AxisTitle
                    .Text = rngSource.Cells(1, MeasurementDateColumn)
                    .Orientation = xlHorizontal
                    .Characters.Font.Size = 14
                End With
                .CategoryType = xlTimeScale
                .MinimumScale = dateCurrent
                .MaximumScale = DateAdd("d", 1, dateCurrent)
                .MajorUnit = #6:00:00 AM#
                .MinorUnit = #1:00:00 AM#
                .MajorTickMark = xlTickMarkInside
                .MinorTickMark = xlTickMarkInside
                With .MajorGridlines.Format.Line
                    .Visible = True
                    .DashStyle = msoLineDash
                    .ForeColor.RGB = rgbGray
                End With
                .TickLabelPosition = xlTickLabelPositionNextToAxis
                .TickLabels.NumberFormat = "h:mm"
            End With
            Set axisTarget = Nothing
             
            chartTarget.SetElement msoElementPrimaryValueAxisShow
            chartTarget.SetElement msoElementPrimaryValueGridLinesMajor
            Set axisTarget = chartTarget.Axes(xlValue, xlPrimary)
            With axisTarget
                .HasTitle = True
                With .AxisTitle
                    .Text = rngSource.Cells(1, TemperatureColumn)
                    .Orientation = xlVertical
                    .Characters.Font.Size = 14
                End With
                .Crosses = xlAxisCrossesAutomatic
                .MinimumScale = WorksheetFunction.Floor(dblMinimumTemperature, 5)
                .MaximumScale = WorksheetFunction.Ceiling(dblMaximumTemperature, 5)
                .MinorUnit = 0.5
                .MajorUnit = 1
                .MajorTickMark = xlTickMarkInside
                .MinorTickMark = xlTickMarkInside
                With .MajorGridlines.Format.Line
                    .Visible = True
                    .DashStyle = msoLineDash
                    .ForeColor.RGB = rgbGray
                End With
                .TickLabelPosition = xlTickLabelPositionNextToAxis
                .TickLabels.NumberFormat = "0""℃"""
            End With
            Set axisTarget = Nothing
             
            chartTarget.SetElement msoElementSecondaryValueAxisShow
            Set axisTarget = chartTarget.Axes(xlValue, xlSecondary)
            With axisTarget
                .HasTitle = True
                With .AxisTitle
                    .Text = rngSource.Cells(1, PressureColumn)
                    .Orientation = xlVertical
                    .Characters.Font.Size = 14
                End With
                .Crosses = xlAxisCrossesAutomatic
                .MinimumScale = WorksheetFunction.Floor(dblMinimumPressure, 10)
                .MaximumScale = WorksheetFunction.Ceiling(dblMaximumPressure, 10)
                .MinorUnit = 5
                .MajorUnit = 10
                .MajorTickMark = xlTickMarkInside
                .MinorTickMark = xlTickMarkInside
                With .MajorGridlines.Format.Line
                    .Visible = False
                End With
                .TickLabelPosition = xlTickLabelPositionNextToAxis
                .TickLabels.NumberFormat = "0"
            End With
            Set axisTarget = Nothing
            
            Set rngXValues = Nothing
            Set rngYValues1 = Nothing
            Set rngYValues2 = Nothing
            
            Set chartTarget = Nothing
            Set chartObjectNew = Nothing
            
            lngPlotStartRow = lngPlotEndRow + 1
            lngPlotEndRow = lngPlotStartRow
            lngChartTop = lngChartTop + lngChartHeight
        End If
        Set rngTargetCell = Nothing
    Next

    rngTopLeftCell.Select

    Application.ScreenUpdating = True

    Set rngTopLeftCell = Nothing
    Set rngSource = Nothing
    Set wsSource = Nothing

End Sub

Comments

[kanakann]

ありがとうございます!!
問題が解決できました