毎月とか隔週に連動して日付を変えたい

質問

OKWAVEで質問してある程度出来が上がってきましたが、まだ解決できないところがあり、
ご指導下さい、

M列に０以上の数字が入力されたらA列の日付を変えたい

B列の　毎日は　＋１日後
B列の　毎週は　＋７日後

つまり

M1に０以上なら　5／5が表示できるようにしたい(＋１日後)
M6に０以上なら　5／13が表示できるようにしたい(＋７日後)

それが下記の計算式です。

-------------------------------------
エクセルのシート名タブを右クリックしてコードの表示－現れたシートに下記をコピー貼り付けています

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim h As Range
Dim c As Long
On Error Resume Next

For Each h In Application.Intersect(Target, Range("M:M"))
If h > 0 Then
If Cells(h.Row, "B") = "毎日" Then
c = 1
ElseIf Cells(h.Row, "B") = "毎週" Then
c = 7
Else
c = 0
End If
Cells(h.Row, "A") = Cells(h.Row, "A") + c
End If
Next
End Sub

－－－－－－－－－－－－－－－－
＜質問１＞
毎月、隔月、隔週　　は下記であってますか？どこに入れたら動作するのでしょうか？

ElseIf Cells(h.Row, "B") = "毎月" Then
c = 30
Else
c = 0
End If

ElseIf Cells(h.Row, "B") = "隔月" Then
c = 60
Else
c = 0
End If

ElseIf Cells(h.Row, "B") = "隔週" Then
c = 14
Else
c = 0
End If

投稿日時 - 2012-05-04 10:29:04

回答No.1

keithin · ベストアンサー

ごく一般的には「毎月」とは「翌月同日」の意味で＋３０日ではありませんが、あなたのそのお仕事では＋３０日、＋６０日、＋１２０日刻みのことなのですか？そういう職種もあります。
これは一般にどうこうじゃなく、個別のお仕事での決め事の問題ですから、あなたがご自分の仕事においてご自分で決めないと誰に聞いても答えは出てきません。

作成例：
private sub Worksheet_Change(byval Target as excel.range)
　dim h as range
　on error resume next
　for each h in application.intersect(target, range("M:M"))
　if h > 0 then
　　select case cells(h.row, "B")
　　case "毎日"
　　　cells(h.row, "A") = cells(h.row, "A") + 1
　　case "毎週"
　　　cells(h.row, "A") = cells(h.row, "A") + 7
　　case "隔週"
　　　cells(h.row, "A") = cells(h.row, "A") + 14
　　case "毎月"
　　　cells(h.row, "A") = dateadd("M", 1, cells(h.row, "A"))
　　case "隔月"
　　　cells(h.row, "A") = dateadd("M", 2, cells(h.row, "A"))
　　end select
　end if
　next
end sub

＃余談ですが
それでもし「翌月同日」なら、アナタの今やろうとしてるアプローチで破たんしている問題としては、たとえば1/31を開始で毎月を加算していった場合、翌月や翌々月は一体どういう日付の推移になっていくのかといったケースがあります。前回のご質問でほかの方からアドバイスが寄せられていましたが、起算日の記録を抹消して日付を都度書き換えようとしているので、こういう破たんが起こります。
＋３０日ルールなら、もちろんこういう問題は起こりません。

お礼

ありがとうございます。親身な回答とても参考になりました
おっしゃるように、この方法では破綻するかもしれませんが、他に方法がみあたらず、エクセルの前で困ってしまっている状態です。