質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

新規登録して質問してみよう
ただいま回答率
85.44%
VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

マクロ

定義された処理手続きに応じて、どのような一連の処理を行うのかを特定させるルールをマクロと呼びます。

Q&A

解決済

1回答

677閲覧

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

kanakann

総合スコア1

VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

マクロ

定義された処理手続きに応じて、どのような一連の処理を行うのかを特定させるルールをマクロと呼びます。

0グッド

0クリップ

投稿2023/05/31 11:44

実現したいこと

・二つのデータの折れ線グラフを作成したい。(横軸;日時、縦軸;計測値)
・全部のデータを利用したブラフを作成する(横軸;測定した日時すべて、縦軸;対応する測定値)
・一日毎のデータグラフを個別(データごと)に作成する。(横軸;一日分の測定時間、縦軸;対応する測定値)
・グラフタイトルを、測定した日付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文の中に入れたり、指定方法を変えたりしたのですが、構文エラーや処理落ちをしてしまいました。また、一つのグラフに二つのデータが入る問題が解決できませんでした。

気になる質問をクリップする

クリップした質問は、後からいつでもMYページで確認できます。

またクリップした質問に回答があった際、通知やメールを受け取ることができます。

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

kikukiku

2023/06/01 00:01

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

2023/06/04 12:53

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

回答1

0

ベストアンサー

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

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

vba

1Sub AddChartObjectsByDate() 2 3 Const TableTopLeftCellAddress As String = "A1" 4 Const TableColumnsCount As Long = 5 5 6 Const MeasurementDateColumn As Long = 3 7 Const TemperatureColumn As Long = 4 8 Const PressureColumn As Long = 5 9 10 Dim wsSource As Excel.Worksheet 11 Dim rngTopLeftCell As Excel.Range 12 Dim rngSource As Excel.Range 13 Dim lngHeaderRow As Long 14 Dim lngLastColumn As Long 15 Dim lngFirstDataRow As Long 16 Dim lngLastDataRow As Long 17 Dim dblMinimumTemperature As Double 18 Dim dblMaximumTemperature As Double 19 Dim dblMinimumPressure As Double 20 Dim dblMaximumPressure As Double 21 22 Set wsSource = ActiveSheet 23 24 With wsSource 25 26 Set rngTopLeftCell = .Range(TableTopLeftCellAddress) 27 28 lngHeaderRow = rngTopLeftCell.Row 29 lngLastColumn = rngTopLeftCell.Offset(0, TableColumnsCount - 1).Column 30 31 lngFirstDataRow = lngHeaderRow + 1 32 lngLastDataRow = .Cells(.Rows.Count, rngTopLeftCell.Column).End(xlUp).Row 33 34 If lngLastDataRow < lngFirstDataRow Then 35 Set wsSource = Nothing 36 Exit Sub 37 End If 38 39 If .AutoFilterMode = True Then 40 .AutoFilter.ShowAllData 41 .AutoFilterMode = False 42 End If 43 44 Set rngSource = .Range(rngTopLeftCell, _ 45 .Cells(lngLastDataRow, lngLastColumn)) 46 47 rngSource.AutoFilter 48 49 With .AutoFilter.Sort 50 .SortFields.Clear 51 .Header = xlYes 52 .MatchCase = False 53 .Orientation = xlTopToBottom 54 .SortFields.Add2 Key:=rngSource.Columns(MeasurementDateColumn), _ 55 SortOn:=xlSortOnValues, _ 56 Order:=xlAscending, _ 57 DataOption:=xlSortNormal 58 .Apply 59 End With 60 61 End With 62 63 With rngSource 64 dblMinimumTemperature = WorksheetFunction.Min(.Columns(TemperatureColumn)) 65 dblMaximumTemperature = WorksheetFunction.Max(.Columns(TemperatureColumn)) 66 dblMinimumPressure = WorksheetFunction.Min(.Columns(PressureColumn)) 67 dblMaximumPressure = WorksheetFunction.Max(.Columns(PressureColumn)) 68 End With 69 70 Dim chartObjectNew As Excel.ChartObject 71 Dim chartTarget As Excel.chart 72 Dim seriesTarget As Excel.Series 73 Dim axisTarget As Excel.Axis 74 Dim rngTargetCell As Excel.Range 75 Dim rngXValues As Excel.Range 76 Dim rngYValues1 As Excel.Range 77 Dim rngYValues2 As Excel.Range 78 Dim lngRow As Long 79 Dim lngPlotStartRow As Long 80 Dim lngPlotEndRow As Long 81 Dim lngChartLeft As Long 82 Dim lngChartTop As Long 83 Dim lngChartWidth As Long 84 Dim lngChartHeight As Long 85 Dim dateCurrent As Date 86 87 lngPlotStartRow = 2 88 lngPlotEndRow = lngPlotStartRow 89 90 With wsSource.Cells(lngHeaderRow, lngLastColumn + 2) 91 lngChartLeft = .Left 92 lngChartTop = .Top 93 lngChartWidth = 640 94 lngChartHeight = 480 95 End With 96 97 Application.ScreenUpdating = False 98 99 If wsSource.ChartObjects.Count > 0 Then 100 wsSource.ChartObjects.Delete 101 End If 102 103 For lngRow = 2 To rngSource.Rows.Count 104 Set rngTargetCell = rngSource.Cells(lngRow, MeasurementDateColumn) 105 If Format(rngTargetCell.Value, "yyyy/mm/dd") <> Format(rngTargetCell.Offset(1, 0).Value, "yyyy/mm/dd") Then 106 107 dateCurrent = Format(rngTargetCell.Value, "yyyy/mm/dd") 108 lngPlotEndRow = lngRow 109 110 With rngSource 111 Set rngXValues = wsSource.Range(.Cells(lngPlotStartRow, MeasurementDateColumn), _ 112 .Cells(lngPlotEndRow, MeasurementDateColumn)) 113 Set rngYValues1 = wsSource.Range(.Cells(lngPlotStartRow, TemperatureColumn), _ 114 .Cells(lngPlotEndRow, TemperatureColumn)) 115 Set rngYValues2 = wsSource.Range(.Cells(lngPlotStartRow, PressureColumn), _ 116 .Cells(lngPlotEndRow, PressureColumn)) 117 End With 118 119 Set chartObjectNew = wsSource.ChartObjects.Add(lngChartLeft, lngChartTop, lngChartWidth, lngChartHeight) 120 Set chartTarget = chartObjectNew.chart 121 122 With chartTarget 123 .HasTitle = True 124 .ChartTitle.Text = "daily-graph (" & Format(dateCurrent, "yyyy/mm/dd") & ")" 125 .HasLegend = True 126 .Legend.Position = xlLegendPositionBottom 127 End With 128 129 Set seriesTarget = chartTarget.SeriesCollection.NewSeries 130 With seriesTarget 131 .ChartType = xlXYScatterLinesNoMarkers 132 .AxisGroup = xlPrimary 133 .Name = rngSource.Cells(1, TemperatureColumn) 134 .XValues = rngXValues 135 .Values = rngYValues1 136 .Format.Line.Weight = 1 137 End With 138 Set seriesTarget = Nothing 139 140 Set seriesTarget = chartTarget.SeriesCollection.NewSeries 141 With seriesTarget 142 .ChartType = xlXYScatterLinesNoMarkers 143 .AxisGroup = xlSecondary 144 .Name = rngSource.Cells(1, PressureColumn) 145 .XValues = rngXValues 146 .Values = rngYValues2 147 .Format.Line.Weight = 1 148 End With 149 Set seriesTarget = Nothing 150 151 chartTarget.SetElement msoElementPrimaryCategoryAxisShow 152 chartTarget.SetElement msoElementPrimaryCategoryGridLinesMajor 153 Set axisTarget = chartTarget.Axes(xlCategory, xlPrimary) 154 With axisTarget 155 .HasTitle = True 156 With .AxisTitle 157 .Text = rngSource.Cells(1, MeasurementDateColumn) 158 .Orientation = xlHorizontal 159 .Characters.Font.Size = 14 160 End With 161 .CategoryType = xlTimeScale 162 .MinimumScale = dateCurrent 163 .MaximumScale = DateAdd("d", 1, dateCurrent) 164 .MajorUnit = #6:00:00 AM# 165 .MinorUnit = #1:00:00 AM# 166 .MajorTickMark = xlTickMarkInside 167 .MinorTickMark = xlTickMarkInside 168 With .MajorGridlines.Format.Line 169 .Visible = True 170 .DashStyle = msoLineDash 171 .ForeColor.RGB = rgbGray 172 End With 173 .TickLabelPosition = xlTickLabelPositionNextToAxis 174 .TickLabels.NumberFormat = "h:mm" 175 End With 176 Set axisTarget = Nothing 177 178 chartTarget.SetElement msoElementPrimaryValueAxisShow 179 chartTarget.SetElement msoElementPrimaryValueGridLinesMajor 180 Set axisTarget = chartTarget.Axes(xlValue, xlPrimary) 181 With axisTarget 182 .HasTitle = True 183 With .AxisTitle 184 .Text = rngSource.Cells(1, TemperatureColumn) 185 .Orientation = xlVertical 186 .Characters.Font.Size = 14 187 End With 188 .Crosses = xlAxisCrossesAutomatic 189 .MinimumScale = WorksheetFunction.Floor(dblMinimumTemperature, 5) 190 .MaximumScale = WorksheetFunction.Ceiling(dblMaximumTemperature, 5) 191 .MinorUnit = 0.5 192 .MajorUnit = 1 193 .MajorTickMark = xlTickMarkInside 194 .MinorTickMark = xlTickMarkInside 195 With .MajorGridlines.Format.Line 196 .Visible = True 197 .DashStyle = msoLineDash 198 .ForeColor.RGB = rgbGray 199 End With 200 .TickLabelPosition = xlTickLabelPositionNextToAxis 201 .TickLabels.NumberFormat = "0""℃""" 202 End With 203 Set axisTarget = Nothing 204 205 chartTarget.SetElement msoElementSecondaryValueAxisShow 206 Set axisTarget = chartTarget.Axes(xlValue, xlSecondary) 207 With axisTarget 208 .HasTitle = True 209 With .AxisTitle 210 .Text = rngSource.Cells(1, PressureColumn) 211 .Orientation = xlVertical 212 .Characters.Font.Size = 14 213 End With 214 .Crosses = xlAxisCrossesAutomatic 215 .MinimumScale = WorksheetFunction.Floor(dblMinimumPressure, 10) 216 .MaximumScale = WorksheetFunction.Ceiling(dblMaximumPressure, 10) 217 .MinorUnit = 5 218 .MajorUnit = 10 219 .MajorTickMark = xlTickMarkInside 220 .MinorTickMark = xlTickMarkInside 221 With .MajorGridlines.Format.Line 222 .Visible = False 223 End With 224 .TickLabelPosition = xlTickLabelPositionNextToAxis 225 .TickLabels.NumberFormat = "0" 226 End With 227 Set axisTarget = Nothing 228 229 Set rngXValues = Nothing 230 Set rngYValues1 = Nothing 231 Set rngYValues2 = Nothing 232 233 Set chartTarget = Nothing 234 Set chartObjectNew = Nothing 235 236 lngPlotStartRow = lngPlotEndRow + 1 237 lngPlotEndRow = lngPlotStartRow 238 lngChartTop = lngChartTop + lngChartHeight 239 End If 240 Set rngTargetCell = Nothing 241 Next 242 243 rngTopLeftCell.Select 244 245 Application.ScreenUpdating = True 246 247 Set rngTopLeftCell = Nothing 248 Set rngSource = Nothing 249 Set wsSource = Nothing 250 251End Sub

投稿2023/06/01 07:44

sk.exe

総合スコア857

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

kanakann

2023/06/06 10:55

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

あなたの回答

tips

太字

斜体

打ち消し線

見出し

引用テキストの挿入

コードの挿入

リンクの挿入

リストの挿入

番号リストの挿入

表の挿入

水平線の挿入

プレビュー

15分調べてもわからないことは
teratailで質問しよう!

ただいまの回答率
85.44%

質問をまとめることで
思考を整理して素早く解決

テンプレート機能で
簡単に質問をまとめる

質問する

関連した質問