バイトから戻って、またパソコンに向かう。起きたときに考えたことを実装してやろう。
平均湿度が70%以上の日数をカウント、それと日照時間0の日数をカウント。平均湿度が70%以上の日数をカウントするコードはこれまでのコードを参考に簡単に書けたし、結果も正しかった。が、日照時間0の日数をカウントの結果は、日照時間0の日は21日間で28回です。と、あり得ない数値を返してきた。おっかしいな、〇〇=0 をカウントで間違ってるか ?
コードをコピペしてChatGPTに質問。コードに間違いはないという。空欄 "" を入れていないか。いや、すべて数値を打ち込んでいる。何度かコードを提供してきたが、結果は変わらない。GeminiやCoPilotにも聞いた。同じように空欄や0をローマ字のOと間違ってないかとか。オレそんな馬鹿じゃないぞ。なんか小難しいコードを返してきたが、自分の求める結果にならない。
じっとシートを見つめた。21日間の中に0の日は7回。試しにまだ未入力の行数を数えた。21個。ん、分かった。、〇〇=0 をカウントは0の回数と未記入の "" の加算だ。
どうしたらいい ? 空欄でなく、且つ0の回数だ。式を書いて実行したら果たして、21日間で0の日は7回です。OK、これだ。これ、10年前のExcelにどっぷり浸かってる頃だったら直ぐに対応出来てたかも。
まったく、AI3つが訳の分からんことを返してきて。ChatGPTに出来たよと言ったら、しれっとその通りですねなどと返してきた。
その後、Formに表示する情報が多すぎるので2回に分けることにした。それに1つだと、改行文字数が制限を超えていますなどとExcelは通知してくるし。あと降水量が20mmを超えた日数も書き加えた。
情報を返してくるマクロは370行にもなった。これは、AIの助けなしには昔の自分でも無理だ。昔だったらいくつものマクロに分けていただろう。
ChatGPTに
分かりました。
以下で求めることができました。
' 2024/3/28追加
' 日照時間0の日数を求める
Dim datesRange3 As Range
Dim NoSunshineDays As Range
Dim totalNoSunshineDays As Integer
' 日付の範囲を指定
Set datesRange3 = ws.Range("B3:B50")
' 日照時間の範囲を指定
Set NoSunshineDays = ws.Range("K3:K50")
' データの走査
For i = 1 To datesRange3.Rows.count
' 日照時間0
If NoSunshineDays.Cells(i).Value <> "" And NoSunshineDays.Cells(i).Value = 0 Then
totalNoSunshineDays = totalNoSunshineDays + 1 ' 日照時間0の日数をカウント
End If
Next i
ChatGPT
理解しました。追加の条件 NoSunshineDays.Cells(i).Value <> "" を使用して、セルが空でないことを確認し、かつ日照時間が0である場合にのみカウントするようにしましたね。
この変更により、セルの値が空でないことを確認しているため、正しく日照時間0の日数をカウントできるようになります。この方法で問題が解決されたようですね。
Sub ShowWeatherInfo()
' chatGPT 2024/3/9
' 3/10に整形
' 3/22にさらに項目を追加
' 3/28 メッセージを追加
Dim ws As Worksheet
Dim lastRow As Long
Dim maxTempC As Double '最高気温最大 C列
Dim minTempC As Double '最高気温最小 C列
Dim maxTempD As Double '最低気温最高 D列
Dim minTempD As Double '最低気温最小 D列
Dim maxTempDateC As String
Dim minTempDateC As String
Dim maxTempDateD As String
Dim minTempDateD As String
Dim maxTempAvg As Double '平均気温最大 E列
Dim minTempAvg As Double '平均気温最小 E列
Dim maxTempAvgDate As String
Dim minTempAvgDate As String
Dim maxTempDiff As Double '気温差最大 F列
Dim minTempDiff As Double '気温差最小 F列
Dim maxTempDiffDate As String
Dim minTempDiffDate As String
Dim maxYearDiff As Double '昨年比最大 G列
Dim minYearDiff As Double '昨年比最小 G列
Dim maxYearDiffDate As String
Dim minYearDiffDate As String
Dim maxPrecipitation As Double '降水量最大 H列
Dim minPrecipitation As Double '降水量最小 H列
Dim maxPrecipitationDate As String
Dim minPrecipitationDate As String
Dim maxHumidityAvg As Double '平均湿度最大 I列
Dim minHumidityAvg As Double '平均湿度最小 I列
Dim maxHumidityAvgDate As String
Dim minHumidityAvgDate As String
Dim maxMaxGustSpeed As Double '最大瞬間風速最大 J列
Dim minMaxGustSpeed As Double '最大瞬間風速最小 J列
Dim maxMaxGustSpeedDate As String
Dim minMaxGustSpeedDate As String
Dim maxSunshineDuration As Double '日照時間最大 K列
Dim minSunshineDuration As Double '日照時間最小 K列
Dim maxSunshineDurationDate As String
Dim minSunshineDurationDate As String
Dim i As Long
Set ws = ThisWorkbook.ActiveSheet ' アクティブなシートを選択
lastRow = ws.Cells(ws.Rows.count, "B").End(xlUp).Row ' 最終行を取得
' 初期値を設定
maxTempC = ws.Cells(3, "C").Value
minTempC = ws.Cells(3, "C").Value
maxTempD = ws.Cells(3, "D").Value
minTempD = ws.Cells(3, "D").Value
maxTempDateC = ws.Cells(3, "B").Value
minTempDateC = ws.Cells(3, "B").Value
maxTempDateD = ws.Cells(3, "B").Value
minTempDateD = ws.Cells(3, "B").Value
maxTempAvg = ws.Cells(3, "E").Value
minTempAvg = ws.Cells(3, "E").Value
maxTempAvgDate = ws.Cells(3, "B").Value
minTempAvgDate = ws.Cells(3, "B").Value
maxTempDiff = ws.Cells(3, "F").Value
minTempDiff = ws.Cells(3, "F").Value
maxTempDiffDate = ws.Cells(3, "B").Value
minTempDiffDate = ws.Cells(3, "B").Value
maxYearDiff = ws.Cells(3, "G").Value
minYearDiff = ws.Cells(3, "G").Value
maxYearDiffDate = ws.Cells(3, "B").Value
minYearDiffDate = ws.Cells(3, "B").Value
maxPrecipitation = ws.Cells(3, "H").Value
minPrecipitation = ws.Cells(3, "H").Value
maxPrecipitationDate = ws.Cells(3, "B").Value
minPrecipitationDate = ws.Cells(3, "B").Value
maxHumidityAvg = ws.Cells(3, "I").Value
minHumidityAvg = ws.Cells(3, "I").Value
maxHumidityAvgDate = ws.Cells(3, "B").Value
minHumidityAvgDate = ws.Cells(3, "B").Value
maxMaxGustSpeed = ws.Cells(3, "J").Value
minMaxGustSpeed = ws.Cells(3, "J").Value
maxMaxGustSpeedDate = ws.Cells(3, "B").Value
minMaxGustSpeedDate = ws.Cells(3, "B").Value
maxSunshineDuration = ws.Cells(3, "K").Value
minSunshineDuration = ws.Cells(3, "K").Value
maxSunshineDurationDate = ws.Cells(3, "B").Value
minSunshineDurationDate = ws.Cells(3, "B").Value
' データをループして最大値、最小値、日付を取得
For i = 4 To lastRow
' C列(最高気温)の最大値
If ws.Cells(i, "C").Value > maxTempC Then
maxTempC = ws.Cells(i, "C").Value
maxTempDateC = ws.Cells(i, "B").Value
End If
' C列(最高気温)の最小値
If ws.Cells(i, "C").Value < minTempC And ws.Cells(i, "C").Value <> 0 Then
minTempC = ws.Cells(i, "C").Value
minTempDateC = ws.Cells(i, "B").Value
End If
' D列(最低気温)の最大値
If ws.Cells(i, "D").Value > maxTempD Then
maxTempD = ws.Cells(i, "D").Value
maxTempDateD = ws.Cells(i, "B").Value
End If
' D列(最低気温)の最小値
If (ws.Cells(i, "D").Value < minTempD Or minTempD = 0) And ws.Cells(i, "D").Value <> 0 Then
minTempD = ws.Cells(i, "D").Value
minTempDateD = ws.Cells(i, "B").Value
End If
' 平均気温の最高値
If ws.Cells(i, "E").Value > maxTempAvg And ws.Cells(i, "E").Value <> 0 Then
maxTempAvg = ws.Cells(i, "E").Value
maxTempAvgDate = ws.Cells(i, "B").Value
End If
' 平均気温の最低値
If (ws.Cells(i, "E").Value < minTempAvg Or minTempAvg = 0) And ws.Cells(i, "E").Value <> 0 Then
minTempAvg = ws.Cells(i, "E").Value
minTempAvgDate = ws.Cells(i, "B").Value
End If
' 気温差の最大値
If (ws.Cells(i, "F").Value > maxTempDiff) Then
maxTempDiff = ws.Cells(i, "F").Value
maxTempDiffDate = ws.Cells(i, "B").Value
End If
' 気温差の最小値
If (ws.Cells(i, "F").Value < minTempDiff Or minTempDiff = 0) And ws.Cells(i, "F").Value <> 0 Then
minTempDiff = ws.Cells(i, "F").Value
minTempDiffDate = ws.Cells(i, "B").Value
End If
' 昨年比の最大値
If ws.Cells(i, "G").Value > maxYearDiff Then
maxYearDiff = ws.Cells(i, "G").Value
maxYearDiffDate = ws.Cells(i, "B").Value
End If
' 昨年比の最小値
If ws.Cells(i, "G").Value < minYearDiff Then
minYearDiff = ws.Cells(i, "G").Value
minYearDiffDate = ws.Cells(i, "B").Value
End If
' 降水量の最大値
If ws.Cells(i, "H").Value > maxPrecipitation Then
maxPrecipitation = ws.Cells(i, "H").Value
maxPrecipitationDate = ws.Cells(i, "B").Value
End If
' 降水量の最小値
If (ws.Cells(i, "H").Value < minPrecipitation Or minPrecipitation = 0) And ws.Cells(i, "H").Value <> 0 Then
minPrecipitation = ws.Cells(i, "H").Value
minPrecipitationDate = ws.Cells(i, "B").Value
End If
' 平均湿度の最大値
If ws.Cells(i, "I").Value > maxHumidityAvg And ws.Cells(i, "I").Value <> 0 Then
maxHumidityAvg = ws.Cells(i, "I").Value
maxHumidityAvgDate = ws.Cells(i, "B").Value
End If
' 平均湿度の最小値
If ws.Cells(i, "I").Value < minHumidityAvg And ws.Cells(i, "I").Value <> 0 Then
minHumidityAvg = ws.Cells(i, "I").Value
minHumidityAvgDate = ws.Cells(i, "B").Value
End If
' 最大瞬間風速の最大値
If ws.Cells(i, "J").Value > maxMaxGustSpeed And ws.Cells(i, "J").Value <> 0 Then
maxMaxGustSpeed = ws.Cells(i, "J").Value
maxMaxGustSpeedDate = ws.Cells(i, "B").Value
End If
' 最大瞬間風速の最小値
If ws.Cells(i, "J").Value < minMaxGustSpeed And ws.Cells(i, "J").Value <> 0 Then
minMaxGustSpeed = ws.Cells(i, "J").Value
minMaxGustSpeedDate = ws.Cells(i, "B").Value
End If
' 日照時間の最大値
If ws.Cells(i, "K").Value > maxSunshineDuration And ws.Cells(i, "K").Value <> 0 Then
maxSunshineDuration = ws.Cells(i, "K").Value
maxSunshineDurationDate = ws.Cells(i, "B").Value
End If
' 日照時間の最小値
If ws.Cells(i, "K").Value < minSunshineDuration Or (minSunshineDuration = 0 And ws.Cells(i, "K").Value = 0 And i = 3) Then
minSunshineDuration = ws.Cells(i, "K").Value
minSunshineDurationDate = ws.Cells(i, "B").Value
End If
Next i
' 最終行を取得 E列の最終行
lastRow = ws.Cells(ws.Rows.count, "E").End(xlUp).Row
'Function CountNegativeTemperaturesを統合 3/10
' 平均気温昨年比マイナスの日数を求める
Dim rng As Range
Dim cell As Range
Dim count As Integer
Dim CountNegativeTemperatures As Integer
' G列の範囲を指定
Set rng = ws.Range("G3:G50")
' マイナスの日数をカウントする変数を初期化
count = 0
' 各セルの値を確認し、マイナスの場合はカウントを増やす
For Each cell In rng
If cell.Value < 0 Then
count = count + 1
End If
Next cell
' 結果を関数の戻り値として返す
CountNegativeTemperatures = count
' 2024/3/9追加
' FindRainfallを統合
' 降水のあった日数を求める
Dim datesRange As Range
Dim rainfallRange As Range
Dim totalRainyDays As Integer
' 日付の範囲を指定
Set datesRange = ws.Range("B3:B50")
' 降水量の範囲を指定
Set rainfallRange = ws.Range("H3:H50")
' データの走査
For i = 1 To datesRange.Rows.count
' 降水量が0でない場合
If rainfallRange.Cells(i).Value <> "" Then
totalRainyDays = totalRainyDays + 1 ' 降水のあった日数をカウント
End If
Next i
' 2024/3/28追加
' 平均湿度70%以上の日数を求める
Dim datesRange2 As Range
Dim HighHumidityDays As Range
Dim totalHighHumidityDays As Integer
' 日付の範囲を指定
Set datesRange2 = ws.Range("B3:B50")
' 平均湿度の範囲を指定
Set HighHumidityDays = ws.Range("I3:I50")
' データの走査
For i = 1 To datesRange2.Rows.count
' 平均湿度70%
If HighHumidityDays.Cells(i).Value >= 70 Then
totalHighHumidityDays = totalHighHumidityDays + 1 ' 湿度70%以上の日数をカウント
End If
Next i
' 2024/3/28追加
' 日照時間0の日数を求める。 ""でなくかつ0をカウント
Dim datesRange3 As Range
Dim NoSunshineDays As Range
Dim totalNoSunshineDays As Integer
' 日付の範囲を指定
Set datesRange3 = ws.Range("B3:B50")
' 日照時間の範囲を指定
Set NoSunshineDays = ws.Range("K3:K50")
' データの走査
For i = 1 To datesRange3.Rows.count
' 日照時間0
If NoSunshineDays.Cells(i).Value <> "" And NoSunshineDays.Cells(i).Value = 0 Then
totalNoSunshineDays = totalNoSunshineDays + 1 ' 日照時間0の日数をカウント
End If
Next i
' 2024/3/28追加
' 降水量20mm以上の日数を求める
Dim datesRange4 As Range
Dim HighPrecipitationDays As Range
Dim totalHighPrecipitationDays As Integer
' 日付の範囲を指定
Set datesRange4 = ws.Range("B3:B50")
' 降水量の範囲を指定
Set HighPrecipitationDays = ws.Range("H3:H50")
' データの走査
For i = 1 To datesRange4.Rows.count
' 降水量20mm以上
If HighPrecipitationDays.Cells(i).Value >= 20 Then
totalHighPrecipitationDays = totalHighPrecipitationDays + 1 ' 湿度70%以上の日数をカウント
End If
Next i
'最大値と最小値を強調表示
SetColorBold
' メッセージボックスに表示するテキストを設定
' 行連結は24行までらしい。
Dim message As String
message = "最高気温の最大値は " & Format(maxTempDateC, "m月d日") & " の " & maxTempC & "度 、" & _
"最小値は " & Format(minTempDateC, "m月d日") & " の " & minTempC & "度" & vbCrLf & vbCrLf & _
"最低気温の最大値は " & Format(maxTempDateD, "m月d日") & " の " & maxTempD & "度 、" & _
"最小値は " & Format(minTempDateD, "m月d日") & " の " & minTempD & "度" & vbCrLf & vbCrLf & _
"まとめると" & vbCrLf & _
"最高気温は " & Format(maxTempDateC, "m月d日") & " の " & maxTempC & "度 、" & _
"最低気温は " & Format(minTempDateD, "m月d日") & " の " & minTempD & "度" & vbCrLf & vbCrLf & _
"平均気温の最大値は " & Format(maxTempAvgDate, "m月d日") & " の " & maxTempAvg & "度 、" & _
"最小値は " & Format(minTempAvgDate, "m月d日") & " の " & minTempAvg & "度" & vbCrLf & vbCrLf & _
"気温差の最大値は " & Format(maxTempDiffDate, "m月d日") & " の " & maxTempDiff & "度 、" & _
"最小値は " & Format(minTempDiffDate, "m月d日") & " の " & minTempDiff & "度" & vbCrLf & vbCrLf & _
"平均気温が昨年比マイナスの日は " & lastRow - 2 & "日間で " & CountNegativeTemperatures & "回" & vbCrLf & _
"昨年比の最大値は " & Format(maxYearDiffDate, "m月d日") & " の " & maxYearDiff & "度、" & _
"最小値は " & Format(minYearDiffDate, "m月d日") & " の " & minYearDiff & "度 " & vbCrLf & _
"です。" & vbCrLf
Dim message2 As String
message2 = "降水のあった日は " & lastRow - 2 & "日間で " & totalRainyDays & "回" & vbCrLf & _
"降水量の最大値は " & Format(maxPrecipitationDate, "m月d日") & " の " & maxPrecipitation & "mm 、" & _
"最小値は " & Format(minPrecipitationDate, "m月d日") & " の " & minPrecipitation & "mm" & vbCrLf & _
"降水量20mm以上の日は" & lastRow - 2 & "日間で " & totalHighPrecipitationDays & "回" & vbCrLf & _
"総雨量は " & lastRow - 2 & "日間で " & ws.Range("H51").Value & "mm " & vbCrLf & vbCrLf & _
"平均湿度の最大値は " & Format(maxHumidityAvgDate, "m月d日") & " の " & maxHumidityAvg & "% 、" & _
"最小値は " & Format(minHumidityAvgDate, "m月d日") & " の " & minHumidityAvg & "%" & vbCrLf & _
"平均湿度70%以上の日は " & lastRow - 2 & "日間で " & totalHighHumidityDays & "回" & vbCrLf & vbCrLf & _
"最大瞬間風速の最大値は " & Format(maxMaxGustSpeedDate, "m月d日") & " の " & maxMaxGustSpeed & "m 、" & _
"最小値は " & Format(minMaxGustSpeedDate, "m月d日") & " の " & minMaxGustSpeed & "m" & vbCrLf & vbCrLf & _
"日照時間の最大値は " & Format(maxSunshineDurationDate, "m月d日") & " の " & maxSunshineDuration & "時間、" & _
"最小値は " & Format(minSunshineDurationDate, "m月d日") & " の " & minSunshineDuration & "時間 " & vbCrLf & _
"日照時間0の日は " & lastRow - 2 & "日間で " & totalNoSunshineDays & "回" & vbCrLf & _
"です。" & vbCrLf
' メッセージを表示 2024/3/25 3/28
' Form1を表示
UserForm1.TextBox1.MultiLine = True
UserForm1.TextBox1.EnterKeyBehavior = True
UserForm1.TextBox1.Text = message
UserForm1.Show
Dim rtn As Integer
rtn = MsgBox("補足情報を表示しますか ? ", vbYesNo + vbQuestion + vbDefaultButton1, "確認")
Select Case rtn
Case vbYes
' Form2を表示
UserForm2.TextBox1.MultiLine = True
UserForm2.TextBox1.EnterKeyBehavior = True
UserForm2.TextBox1.Text = message2
UserForm2.Show
Case vbNo
' 何もしない
End Select
'書体を復元
ResetFormat
End Sub
平均湿度が70%以上の日数をカウント、それと日照時間0の日数をカウント。平均湿度が70%以上の日数をカウントするコードはこれまでのコードを参考に簡単に書けたし、結果も正しかった。が、日照時間0の日数をカウントの結果は、日照時間0の日は21日間で28回です。と、あり得ない数値を返してきた。おっかしいな、〇〇=0 をカウントで間違ってるか ?
コードをコピペしてChatGPTに質問。コードに間違いはないという。空欄 "" を入れていないか。いや、すべて数値を打ち込んでいる。何度かコードを提供してきたが、結果は変わらない。GeminiやCoPilotにも聞いた。同じように空欄や0をローマ字のOと間違ってないかとか。オレそんな馬鹿じゃないぞ。なんか小難しいコードを返してきたが、自分の求める結果にならない。
じっとシートを見つめた。21日間の中に0の日は7回。試しにまだ未入力の行数を数えた。21個。ん、分かった。、〇〇=0 をカウントは0の回数と未記入の "" の加算だ。
どうしたらいい ? 空欄でなく、且つ0の回数だ。式を書いて実行したら果たして、21日間で0の日は7回です。OK、これだ。これ、10年前のExcelにどっぷり浸かってる頃だったら直ぐに対応出来てたかも。
まったく、AI3つが訳の分からんことを返してきて。ChatGPTに出来たよと言ったら、しれっとその通りですねなどと返してきた。
その後、Formに表示する情報が多すぎるので2回に分けることにした。それに1つだと、改行文字数が制限を超えていますなどとExcelは通知してくるし。あと降水量が20mmを超えた日数も書き加えた。
情報を返してくるマクロは370行にもなった。これは、AIの助けなしには昔の自分でも無理だ。昔だったらいくつものマクロに分けていただろう。
ChatGPTに
分かりました。
以下で求めることができました。
' 2024/3/28追加
' 日照時間0の日数を求める
Dim datesRange3 As Range
Dim NoSunshineDays As Range
Dim totalNoSunshineDays As Integer
' 日付の範囲を指定
Set datesRange3 = ws.Range("B3:B50")
' 日照時間の範囲を指定
Set NoSunshineDays = ws.Range("K3:K50")
' データの走査
For i = 1 To datesRange3.Rows.count
' 日照時間0
If NoSunshineDays.Cells(i).Value <> "" And NoSunshineDays.Cells(i).Value = 0 Then
totalNoSunshineDays = totalNoSunshineDays + 1 ' 日照時間0の日数をカウント
End If
Next i
ChatGPT
理解しました。追加の条件 NoSunshineDays.Cells(i).Value <> "" を使用して、セルが空でないことを確認し、かつ日照時間が0である場合にのみカウントするようにしましたね。
この変更により、セルの値が空でないことを確認しているため、正しく日照時間0の日数をカウントできるようになります。この方法で問題が解決されたようですね。
Sub ShowWeatherInfo()
' chatGPT 2024/3/9
' 3/10に整形
' 3/22にさらに項目を追加
' 3/28 メッセージを追加
Dim ws As Worksheet
Dim lastRow As Long
Dim maxTempC As Double '最高気温最大 C列
Dim minTempC As Double '最高気温最小 C列
Dim maxTempD As Double '最低気温最高 D列
Dim minTempD As Double '最低気温最小 D列
Dim maxTempDateC As String
Dim minTempDateC As String
Dim maxTempDateD As String
Dim minTempDateD As String
Dim maxTempAvg As Double '平均気温最大 E列
Dim minTempAvg As Double '平均気温最小 E列
Dim maxTempAvgDate As String
Dim minTempAvgDate As String
Dim maxTempDiff As Double '気温差最大 F列
Dim minTempDiff As Double '気温差最小 F列
Dim maxTempDiffDate As String
Dim minTempDiffDate As String
Dim maxYearDiff As Double '昨年比最大 G列
Dim minYearDiff As Double '昨年比最小 G列
Dim maxYearDiffDate As String
Dim minYearDiffDate As String
Dim maxPrecipitation As Double '降水量最大 H列
Dim minPrecipitation As Double '降水量最小 H列
Dim maxPrecipitationDate As String
Dim minPrecipitationDate As String
Dim maxHumidityAvg As Double '平均湿度最大 I列
Dim minHumidityAvg As Double '平均湿度最小 I列
Dim maxHumidityAvgDate As String
Dim minHumidityAvgDate As String
Dim maxMaxGustSpeed As Double '最大瞬間風速最大 J列
Dim minMaxGustSpeed As Double '最大瞬間風速最小 J列
Dim maxMaxGustSpeedDate As String
Dim minMaxGustSpeedDate As String
Dim maxSunshineDuration As Double '日照時間最大 K列
Dim minSunshineDuration As Double '日照時間最小 K列
Dim maxSunshineDurationDate As String
Dim minSunshineDurationDate As String
Dim i As Long
Set ws = ThisWorkbook.ActiveSheet ' アクティブなシートを選択
lastRow = ws.Cells(ws.Rows.count, "B").End(xlUp).Row ' 最終行を取得
' 初期値を設定
maxTempC = ws.Cells(3, "C").Value
minTempC = ws.Cells(3, "C").Value
maxTempD = ws.Cells(3, "D").Value
minTempD = ws.Cells(3, "D").Value
maxTempDateC = ws.Cells(3, "B").Value
minTempDateC = ws.Cells(3, "B").Value
maxTempDateD = ws.Cells(3, "B").Value
minTempDateD = ws.Cells(3, "B").Value
maxTempAvg = ws.Cells(3, "E").Value
minTempAvg = ws.Cells(3, "E").Value
maxTempAvgDate = ws.Cells(3, "B").Value
minTempAvgDate = ws.Cells(3, "B").Value
maxTempDiff = ws.Cells(3, "F").Value
minTempDiff = ws.Cells(3, "F").Value
maxTempDiffDate = ws.Cells(3, "B").Value
minTempDiffDate = ws.Cells(3, "B").Value
maxYearDiff = ws.Cells(3, "G").Value
minYearDiff = ws.Cells(3, "G").Value
maxYearDiffDate = ws.Cells(3, "B").Value
minYearDiffDate = ws.Cells(3, "B").Value
maxPrecipitation = ws.Cells(3, "H").Value
minPrecipitation = ws.Cells(3, "H").Value
maxPrecipitationDate = ws.Cells(3, "B").Value
minPrecipitationDate = ws.Cells(3, "B").Value
maxHumidityAvg = ws.Cells(3, "I").Value
minHumidityAvg = ws.Cells(3, "I").Value
maxHumidityAvgDate = ws.Cells(3, "B").Value
minHumidityAvgDate = ws.Cells(3, "B").Value
maxMaxGustSpeed = ws.Cells(3, "J").Value
minMaxGustSpeed = ws.Cells(3, "J").Value
maxMaxGustSpeedDate = ws.Cells(3, "B").Value
minMaxGustSpeedDate = ws.Cells(3, "B").Value
maxSunshineDuration = ws.Cells(3, "K").Value
minSunshineDuration = ws.Cells(3, "K").Value
maxSunshineDurationDate = ws.Cells(3, "B").Value
minSunshineDurationDate = ws.Cells(3, "B").Value
' データをループして最大値、最小値、日付を取得
For i = 4 To lastRow
' C列(最高気温)の最大値
If ws.Cells(i, "C").Value > maxTempC Then
maxTempC = ws.Cells(i, "C").Value
maxTempDateC = ws.Cells(i, "B").Value
End If
' C列(最高気温)の最小値
If ws.Cells(i, "C").Value < minTempC And ws.Cells(i, "C").Value <> 0 Then
minTempC = ws.Cells(i, "C").Value
minTempDateC = ws.Cells(i, "B").Value
End If
' D列(最低気温)の最大値
If ws.Cells(i, "D").Value > maxTempD Then
maxTempD = ws.Cells(i, "D").Value
maxTempDateD = ws.Cells(i, "B").Value
End If
' D列(最低気温)の最小値
If (ws.Cells(i, "D").Value < minTempD Or minTempD = 0) And ws.Cells(i, "D").Value <> 0 Then
minTempD = ws.Cells(i, "D").Value
minTempDateD = ws.Cells(i, "B").Value
End If
' 平均気温の最高値
If ws.Cells(i, "E").Value > maxTempAvg And ws.Cells(i, "E").Value <> 0 Then
maxTempAvg = ws.Cells(i, "E").Value
maxTempAvgDate = ws.Cells(i, "B").Value
End If
' 平均気温の最低値
If (ws.Cells(i, "E").Value < minTempAvg Or minTempAvg = 0) And ws.Cells(i, "E").Value <> 0 Then
minTempAvg = ws.Cells(i, "E").Value
minTempAvgDate = ws.Cells(i, "B").Value
End If
' 気温差の最大値
If (ws.Cells(i, "F").Value > maxTempDiff) Then
maxTempDiff = ws.Cells(i, "F").Value
maxTempDiffDate = ws.Cells(i, "B").Value
End If
' 気温差の最小値
If (ws.Cells(i, "F").Value < minTempDiff Or minTempDiff = 0) And ws.Cells(i, "F").Value <> 0 Then
minTempDiff = ws.Cells(i, "F").Value
minTempDiffDate = ws.Cells(i, "B").Value
End If
' 昨年比の最大値
If ws.Cells(i, "G").Value > maxYearDiff Then
maxYearDiff = ws.Cells(i, "G").Value
maxYearDiffDate = ws.Cells(i, "B").Value
End If
' 昨年比の最小値
If ws.Cells(i, "G").Value < minYearDiff Then
minYearDiff = ws.Cells(i, "G").Value
minYearDiffDate = ws.Cells(i, "B").Value
End If
' 降水量の最大値
If ws.Cells(i, "H").Value > maxPrecipitation Then
maxPrecipitation = ws.Cells(i, "H").Value
maxPrecipitationDate = ws.Cells(i, "B").Value
End If
' 降水量の最小値
If (ws.Cells(i, "H").Value < minPrecipitation Or minPrecipitation = 0) And ws.Cells(i, "H").Value <> 0 Then
minPrecipitation = ws.Cells(i, "H").Value
minPrecipitationDate = ws.Cells(i, "B").Value
End If
' 平均湿度の最大値
If ws.Cells(i, "I").Value > maxHumidityAvg And ws.Cells(i, "I").Value <> 0 Then
maxHumidityAvg = ws.Cells(i, "I").Value
maxHumidityAvgDate = ws.Cells(i, "B").Value
End If
' 平均湿度の最小値
If ws.Cells(i, "I").Value < minHumidityAvg And ws.Cells(i, "I").Value <> 0 Then
minHumidityAvg = ws.Cells(i, "I").Value
minHumidityAvgDate = ws.Cells(i, "B").Value
End If
' 最大瞬間風速の最大値
If ws.Cells(i, "J").Value > maxMaxGustSpeed And ws.Cells(i, "J").Value <> 0 Then
maxMaxGustSpeed = ws.Cells(i, "J").Value
maxMaxGustSpeedDate = ws.Cells(i, "B").Value
End If
' 最大瞬間風速の最小値
If ws.Cells(i, "J").Value < minMaxGustSpeed And ws.Cells(i, "J").Value <> 0 Then
minMaxGustSpeed = ws.Cells(i, "J").Value
minMaxGustSpeedDate = ws.Cells(i, "B").Value
End If
' 日照時間の最大値
If ws.Cells(i, "K").Value > maxSunshineDuration And ws.Cells(i, "K").Value <> 0 Then
maxSunshineDuration = ws.Cells(i, "K").Value
maxSunshineDurationDate = ws.Cells(i, "B").Value
End If
' 日照時間の最小値
If ws.Cells(i, "K").Value < minSunshineDuration Or (minSunshineDuration = 0 And ws.Cells(i, "K").Value = 0 And i = 3) Then
minSunshineDuration = ws.Cells(i, "K").Value
minSunshineDurationDate = ws.Cells(i, "B").Value
End If
Next i
' 最終行を取得 E列の最終行
lastRow = ws.Cells(ws.Rows.count, "E").End(xlUp).Row
'Function CountNegativeTemperaturesを統合 3/10
' 平均気温昨年比マイナスの日数を求める
Dim rng As Range
Dim cell As Range
Dim count As Integer
Dim CountNegativeTemperatures As Integer
' G列の範囲を指定
Set rng = ws.Range("G3:G50")
' マイナスの日数をカウントする変数を初期化
count = 0
' 各セルの値を確認し、マイナスの場合はカウントを増やす
For Each cell In rng
If cell.Value < 0 Then
count = count + 1
End If
Next cell
' 結果を関数の戻り値として返す
CountNegativeTemperatures = count
' 2024/3/9追加
' FindRainfallを統合
' 降水のあった日数を求める
Dim datesRange As Range
Dim rainfallRange As Range
Dim totalRainyDays As Integer
' 日付の範囲を指定
Set datesRange = ws.Range("B3:B50")
' 降水量の範囲を指定
Set rainfallRange = ws.Range("H3:H50")
' データの走査
For i = 1 To datesRange.Rows.count
' 降水量が0でない場合
If rainfallRange.Cells(i).Value <> "" Then
totalRainyDays = totalRainyDays + 1 ' 降水のあった日数をカウント
End If
Next i
' 2024/3/28追加
' 平均湿度70%以上の日数を求める
Dim datesRange2 As Range
Dim HighHumidityDays As Range
Dim totalHighHumidityDays As Integer
' 日付の範囲を指定
Set datesRange2 = ws.Range("B3:B50")
' 平均湿度の範囲を指定
Set HighHumidityDays = ws.Range("I3:I50")
' データの走査
For i = 1 To datesRange2.Rows.count
' 平均湿度70%
If HighHumidityDays.Cells(i).Value >= 70 Then
totalHighHumidityDays = totalHighHumidityDays + 1 ' 湿度70%以上の日数をカウント
End If
Next i
' 2024/3/28追加
' 日照時間0の日数を求める。 ""でなくかつ0をカウント
Dim datesRange3 As Range
Dim NoSunshineDays As Range
Dim totalNoSunshineDays As Integer
' 日付の範囲を指定
Set datesRange3 = ws.Range("B3:B50")
' 日照時間の範囲を指定
Set NoSunshineDays = ws.Range("K3:K50")
' データの走査
For i = 1 To datesRange3.Rows.count
' 日照時間0
If NoSunshineDays.Cells(i).Value <> "" And NoSunshineDays.Cells(i).Value = 0 Then
totalNoSunshineDays = totalNoSunshineDays + 1 ' 日照時間0の日数をカウント
End If
Next i
' 2024/3/28追加
' 降水量20mm以上の日数を求める
Dim datesRange4 As Range
Dim HighPrecipitationDays As Range
Dim totalHighPrecipitationDays As Integer
' 日付の範囲を指定
Set datesRange4 = ws.Range("B3:B50")
' 降水量の範囲を指定
Set HighPrecipitationDays = ws.Range("H3:H50")
' データの走査
For i = 1 To datesRange4.Rows.count
' 降水量20mm以上
If HighPrecipitationDays.Cells(i).Value >= 20 Then
totalHighPrecipitationDays = totalHighPrecipitationDays + 1 ' 湿度70%以上の日数をカウント
End If
Next i
'最大値と最小値を強調表示
SetColorBold
' メッセージボックスに表示するテキストを設定
' 行連結は24行までらしい。
Dim message As String
message = "最高気温の最大値は " & Format(maxTempDateC, "m月d日") & " の " & maxTempC & "度 、" & _
"最小値は " & Format(minTempDateC, "m月d日") & " の " & minTempC & "度" & vbCrLf & vbCrLf & _
"最低気温の最大値は " & Format(maxTempDateD, "m月d日") & " の " & maxTempD & "度 、" & _
"最小値は " & Format(minTempDateD, "m月d日") & " の " & minTempD & "度" & vbCrLf & vbCrLf & _
"まとめると" & vbCrLf & _
"最高気温は " & Format(maxTempDateC, "m月d日") & " の " & maxTempC & "度 、" & _
"最低気温は " & Format(minTempDateD, "m月d日") & " の " & minTempD & "度" & vbCrLf & vbCrLf & _
"平均気温の最大値は " & Format(maxTempAvgDate, "m月d日") & " の " & maxTempAvg & "度 、" & _
"最小値は " & Format(minTempAvgDate, "m月d日") & " の " & minTempAvg & "度" & vbCrLf & vbCrLf & _
"気温差の最大値は " & Format(maxTempDiffDate, "m月d日") & " の " & maxTempDiff & "度 、" & _
"最小値は " & Format(minTempDiffDate, "m月d日") & " の " & minTempDiff & "度" & vbCrLf & vbCrLf & _
"平均気温が昨年比マイナスの日は " & lastRow - 2 & "日間で " & CountNegativeTemperatures & "回" & vbCrLf & _
"昨年比の最大値は " & Format(maxYearDiffDate, "m月d日") & " の " & maxYearDiff & "度、" & _
"最小値は " & Format(minYearDiffDate, "m月d日") & " の " & minYearDiff & "度 " & vbCrLf & _
"です。" & vbCrLf
Dim message2 As String
message2 = "降水のあった日は " & lastRow - 2 & "日間で " & totalRainyDays & "回" & vbCrLf & _
"降水量の最大値は " & Format(maxPrecipitationDate, "m月d日") & " の " & maxPrecipitation & "mm 、" & _
"最小値は " & Format(minPrecipitationDate, "m月d日") & " の " & minPrecipitation & "mm" & vbCrLf & _
"降水量20mm以上の日は" & lastRow - 2 & "日間で " & totalHighPrecipitationDays & "回" & vbCrLf & _
"総雨量は " & lastRow - 2 & "日間で " & ws.Range("H51").Value & "mm " & vbCrLf & vbCrLf & _
"平均湿度の最大値は " & Format(maxHumidityAvgDate, "m月d日") & " の " & maxHumidityAvg & "% 、" & _
"最小値は " & Format(minHumidityAvgDate, "m月d日") & " の " & minHumidityAvg & "%" & vbCrLf & _
"平均湿度70%以上の日は " & lastRow - 2 & "日間で " & totalHighHumidityDays & "回" & vbCrLf & vbCrLf & _
"最大瞬間風速の最大値は " & Format(maxMaxGustSpeedDate, "m月d日") & " の " & maxMaxGustSpeed & "m 、" & _
"最小値は " & Format(minMaxGustSpeedDate, "m月d日") & " の " & minMaxGustSpeed & "m" & vbCrLf & vbCrLf & _
"日照時間の最大値は " & Format(maxSunshineDurationDate, "m月d日") & " の " & maxSunshineDuration & "時間、" & _
"最小値は " & Format(minSunshineDurationDate, "m月d日") & " の " & minSunshineDuration & "時間 " & vbCrLf & _
"日照時間0の日は " & lastRow - 2 & "日間で " & totalNoSunshineDays & "回" & vbCrLf & _
"です。" & vbCrLf
' メッセージを表示 2024/3/25 3/28
' Form1を表示
UserForm1.TextBox1.MultiLine = True
UserForm1.TextBox1.EnterKeyBehavior = True
UserForm1.TextBox1.Text = message
UserForm1.Show
Dim rtn As Integer
rtn = MsgBox("補足情報を表示しますか ? ", vbYesNo + vbQuestion + vbDefaultButton1, "確認")
Select Case rtn
Case vbYes
' Form2を表示
UserForm2.TextBox1.MultiLine = True
UserForm2.TextBox1.EnterKeyBehavior = True
UserForm2.TextBox1.Text = message2
UserForm2.Show
Case vbNo
' 何もしない
End Select
'書体を復元
ResetFormat
End Sub