こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

解決済みの質問

エクセル2010を使用しています。

前回VBAについてご教授頂きました。

Private Sub Workbook_Open() 'この行から
With Worksheets("Sheet1")
If .Range("I20") <> Date Then
.Range("H20") = .Range("H20") + 4000000 * ((Year(Date) - Year(.Range("I20"))) * 12 + Month(Date) - Month(.Range("I20")))
.Range("I20") = Date
End If
End With
End Sub 'この行まで

ここまで教えて頂きました。

一つ出来ると、別の欲が沸いてくるもので、次は、特定の月(4月、7月、10月、1月)に1000000ずつ増やしていきたいです。

度々申し訳ございませんが、ご教授頂きたいです。

投稿日時 - 2013-09-30 17:07:17

QNo.8285982

困ってます

質問者が選んだベストアンサー

> 一つ出来ると、別の欲が沸いてくるもので、次は、特定の月(4月、7月、10月、1月)に1000000ずつ増やしていきたいです。

あまりにも正直な気持ちを書かれているのに免じて、これにも回答しましょう。

以下のコードを.Range("I19")をDateに置換して使用してください。
.Range("I19")としたのはバグがないか確認用に使用しました。


Private Sub Workbook_Open() 'この行から
With Worksheets("Sheet1")
Dim diff As Integer ' 前回から今月までの経過月数
diff = (Year(.Range("I19")) - Year(.Range("I20"))) * 12 + Month(.Range("I19")) - Month(.Range("I20"))
If diff > 0 Then ' 前回から一月以上経過したか?
' 前回の翌月から今月までにあった1,4,7,10月をカウント
Dim n As Integer
Select Case Month(.Range("I20")) Mod 3
Case 0:
n = (diff + 2) \ 3
Case 1:
n = diff \ 3
Case 2:
n = (diff + 1) \ 3
End Select
' 数値の更新
.Range("H20") = .Range("H20") + n * 1000000
End If
.Range("I20") = .Range("I19") ' 前回の日付を更新
End With
End Sub 'この行まで


次は、ご自分で少し試行錯誤をしてから質問し、質問には自分で試してみたのは何か、どこが分からないのかを記載しましょう。
そうすれば次の質問にも、私を含めみなさん快く回答するかと思います。

投稿日時 - 2013-09-30 23:31:59

お礼

有難うございました!お陰様で理想的になりました。次回からは仰る通り自分で解決出来るように努力します。それでもわからない場合はまたお願いします。

投稿日時 - 2013-10-01 14:17:34

このQ&Aは役に立ちましたか?

6人が「このQ&Aが役に立った」と投票しています

回答(1)