Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

6222 / 13644 ﾂﾘｰ

←次へ　｜　前へ→

▼

【46482】日付記入について教えてください takashi 07/2/5(月) 11:52

【46483】Re:日付記入について教えてください Kein 07/2/5(月) 12:54

【46484】Re:日付記入について教えてください Kein 07/2/5(月) 13:02

【46486】Re:日付記入について教えてください takashi 07/2/5(月) 13:45

【46488】Re:日付記入について教えてください Kein 07/2/5(月) 14:28

【46491】Re:日付記入について教えてください takashi 07/2/5(月) 14:45

【46493】Re:日付記入について教えてください Kein 07/2/5(月) 15:23

【46494】Re:日付記入について教えてください Kein 07/2/5(月) 15:24

【46501】Re:日付記入について教えてください takashi 07/2/5(月) 16:02

【46506】Re:日付記入について教えてください Kein 07/2/5(月) 16:30

【46507】Re:日付記入について教えてください takashi 07/2/5(月) 16:39

【46490】Re:日付記入について教えてください へっぽこ 07/2/5(月) 14:44

【46499】Re:日付記入について教えてください takashi 07/2/5(月) 15:54

【46503】Re:日付記入について教えてください へっぽこ 07/2/5(月) 16:07

【46505】Re:日付記入について教えてください takashi 07/2/5(月) 16:19

【46508】Re:日付記入について教えてください へっぽこ 07/2/5(月) 16:40

【46513】Re:日付記入について教えてください takashi 07/2/5(月) 17:06

【46515】Re:日付記入について教えてください へっぽこ 07/2/5(月) 17:57

【46516】Re:日付記入について教えてください takashi 07/2/5(月) 18:10

【46517】Re:日付記入について教えてください へっぽこ 07/2/5(月) 18:26

【46520】Re:日付記入について教えてください takashi 07/2/5(月) 20:54

【46540】Re:日付記入について教えてください へっぽこ 07/2/6(火) 10:49

【46545】Re:日付記入について教えてください takashi 07/2/6(火) 12:16


	【46482】日付記入について教えてください

takashi - 07/2/5(月) 11:52 -


	引用なし

	パスワード

セルに仮に20と入力すれば
仮に今日はH19.02.05ですが今月の20日を入力
ただ今日がその月の23日を過ぎれば翌月の20日
としたい。
Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
　If Day(Date) >= 23 Then
この先が解りません。
よろしくお願いします。
列はB20:B350までです。


	【46483】Re:日付記入について教えてください

Kein - 07/2/5(月) 12:54 -


	引用なし

	パスワード

これでどうかな・・? テストはしてませんが。

Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
　 Dim MyD As Integer, AdM As Integer
　
　 If Intersect(Target, Range("B20:B350")) Is _
　　 Nothing Then Exit Sub
　 With Target
　　　If .Count > 1 Then Exit Sub
　　　If IsEmpty(.Value) Then Exit Sub
　　　If Not IsNumeric(.Value) Then Exit Sub
　　　If .Value < 1 Or .Value > 31 Then Exit Sub
　　　MyD = .Value
　 End With
　 If Day(Date) >= 23 Then
　　　AdM = 2
　 Else
　　　AdM = 1
　 End If
　 Application.Enablevents = False
　 If Day(DateSerial(Year(Date), Month(Date) + AdM, 0)) > MyD Then
　　　MsgBox MyD & " 日は存在しません", 48
　 Else
　　　Target.Value = _
　　　DateSerial(Year(Date), Month(Date) + (AdM - 1), MyD)
　　　Target.NumberFormat = "yyyy/m/d"
　 End If
　 Application.Enablevents = True
End Sub


	【46484】Re:日付記入について教えてください

Kein - 07/2/5(月) 13:02 -


	引用なし

	パスワード

テストしてみたら、だいぶ間違えてましたね。
すいません、こっちでやってみて下さい。

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
　 Dim MyD As Integer, AdM As Integer
　
　 If Intersect(Target, Range("B20:B350")) Is _
　　 Nothing Then Exit Sub
　 With Target
　　　If .Count > 1 Then Exit Sub
　　　If IsEmpty(.Value) Then Exit Sub
　　　If Not IsNumeric(.Value) Then Exit Sub
　　　If .Value < 1 Or .Value > 31 Then Exit Sub
　　　MyD = .Value
　 End With
　 If Day(Date) >= 23 Then
　　　AdM = 2
　 Else
　　　AdM = 1
　 End If
　 Application.EnableEvents = False
　 If Day(DateSerial(Year(Date), Month(Date) + AdM, 0)) < MyD Then
　　　MsgBox MyD & " 日は存在しません", 48
　 Else
　　　Target.Value = _
　　　DateSerial(Year(Date), Month(Date) + (AdM - 1), MyD)
　　　Target.NumberFormat = "yyyy/m/d"
　 End If
　 Application.EnableEvents = True
End Sub


	【46486】Re:日付記入について教えてください

takashi - 07/2/5(月) 13:45 -


	引用なし

	パスワード

▼Kein さん：
>テストしてみたら、だいぶ間違えてましたね。
>すいません、こっちでやってみて下さい。

早速ありがとうございます。
書式が標準/G時は初回入力ではH19.02.20と表示しますが
一度消して２回目同じように入力を実行すると
M33.01.20と表示されてしまいます。
下記をどこかに入れたら修正出来るかと思い
やってみたのですが？？？ダメ
Target.NumberFormatLocal = "G/標準"
２度目入れ直しの場合の対処出来ますか。

　 If Day(Date) >= 23 Then
　　　AdM = 2
　 Else
　　　AdM = 1
　 End If
　 Application.EnableEvents = False

　 If Day(DateSerial(Year(Date), Month(Date) + AdM, 0)) < MyD Then
　　　MsgBox MyD & " 日は存在しません", 48
　 Else
　　　Target.Value = _
　　　DateSerial(Year(Date), Month(Date) + (AdM - 1), MyD)
　　　Target.NumberFormat = "ge.mm.dd "’←ここ修正しました。★
　 End If
　 Application.EnableEvents = True
End Sub

>
>Private Sub Worksheet_Change(ByVal Target As Excel.Range)
>　 Dim MyD As Integer, AdM As Integer
>　
>　 If Intersect(Target, Range("B20:B350")) Is _
>　　 Nothing Then Exit Sub
>　 With Target
>　　　If .Count > 1 Then Exit Sub
>　　　If IsEmpty(.Value) Then Exit Sub
>　　　If Not IsNumeric(.Value) Then Exit Sub
>　　　If .Value < 1 Or .Value > 31 Then Exit Sub
>　　　MyD = .Value
>　 End With
>　 If Day(Date) >= 23 Then
>　　　AdM = 2
>　 Else
>　　　AdM = 1
>　 End If
>　 Application.EnableEvents = False
>　 If Day(DateSerial(Year(Date), Month(Date) + AdM, 0)) < MyD Then
>　　　MsgBox MyD & " 日は存在しません", 48
>　 Else
>　　　Target.Value = _
>　　　DateSerial(Year(Date), Month(Date) + (AdM - 1), MyD)
>　　　Target.NumberFormat = "yyyy/m/d"
>　 End If
>　 Application.EnableEvents = True
>End Sub


	【46488】Re:日付記入について教えてください

Kein - 07/2/5(月) 14:28 -


	引用なし

	パスワード

再度テストして、こちらでも現象を確認しました。数値の入力と日付の入力の
タイミングが問題になるようですね・・。何度か改造してみましたが、セル入力
イベントだけではうまく回避できなかったので、セル選択イベントを追加し、
事前に元の日付をクリアするようにしてみました。
再度全体を書き直して、以下のようなマクロになりました。

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
　 Dim MyD As Integer, AdM As Integer
　 Dim CkD As Date, SetD As Date

　 With Target
　　　If Intersect(.Cells, Range("B20:B350")) Is _
　　　 Nothing Then Exit Sub
　　　If .Count > 1 Then Exit Sub
　　　If IsEmpty(.Value) Then Exit Sub
　　　If Not IsNumeric(.Value) Then Exit Sub
　　　If .Value < 1 Or .Value > 31 Then Exit Sub
　　　MyD = .Value
　 End With
　 If Day(Date) >= 23 Then
　　　AdM = 2
　 Else
　　　AdM = 1
　 End If
　 CkD = DateSerial(Year(Date), Month(Date) + AdM, 0)
　 SetD = DateSerial(Year(Date), Month(Date) + (AdM - 1), MyD)
　 If Day(CkD) < MyD Then
　　　MsgBox MyD & " 日は存在しません", 48
　 Else
　　　Application.EnableEvents = False
　　　With Target
　　　　 .Clear
　　　　 .NumberFormat = "ge.mm.dd"
　　　　 .Value = SetD
　　　End With
　　　Application.EnableEvents = True
　 End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
　 With Target
　　　If Intersect(.Cells, Range("B20:B350")) Is _
　　　 Nothing Then Exit Sub
　　　If IsDate(.Value) Then .Clear
　 End With
End Sub


	【46490】Re:日付記入について教えてください

へっぽこ - 07/2/5(月) 14:44 -


	引用なし

	パスワード

横からスミマセン。

Private Sub Worksheet_Change(ByVal Target As Range)
　　Application.EnableEvents = False
　　If Day(Date) >= 23 Then
　　　　Target.Value = DateSerial(Year(Date), Month(Date) + 1, Day(Target.Value2) + 1)
　　Else
　　　　Target.Value = DateSerial(Year(Date), Month(Date), Day(Target.Value2) + 1)
　　End If
　　Application.EnableEvents = True
End Sub

というのはどうでしょうか？

※B20:B350以内の変更だったら？とか入力されたのが数字でなかったら？
　は対応しておりません。


	【46491】Re:日付記入について教えてください

takashi - 07/2/5(月) 14:45 -


	引用なし

	パスワード

▼Kein さん：
何度もありがとうございます。
しかし今回のデータですと初入力時はM33.01.20と表示され
２回目からはH19.02.20になるのですが、そのときに
セルに戻るとデータが消えてしまい
［元々の書式（セルの色＆フォントの設定）等も消える］
また再入力が必要となり　ちょっと不便を感じます。
改良できますか？よろしくお願いします。

>再度テストして、こちらでも現象を確認しました。数値の入力と日付の入力の
>タイミングが問題になるようですね・・。何度か改造してみましたが、セル入力
>イベントだけではうまく回避できなかったので、セル選択イベントを追加し、
>事前に元の日付をクリアするようにしてみました。
>再度全体を書き直して、以下のようなマクロになりました。
>
>Private Sub Worksheet_Change(ByVal Target As Excel.Range)
>　 Dim MyD As Integer, AdM As Integer
>　 Dim CkD As Date, SetD As Date
>
>　 With Target
>　　　If Intersect(.Cells, Range("B20:B350")) Is _
>　　　 Nothing Then Exit Sub
>　　　If .Count > 1 Then Exit Sub
>　　　If IsEmpty(.Value) Then Exit Sub
>　　　If Not IsNumeric(.Value) Then Exit Sub
>　　　If .Value < 1 Or .Value > 31 Then Exit Sub
>　　　MyD = .Value
>　 End With
>　 If Day(Date) >= 23 Then
>　　　AdM = 2
>　 Else
>　　　AdM = 1
>　 End If
>　 CkD = DateSerial(Year(Date), Month(Date) + AdM, 0)
>　 SetD = DateSerial(Year(Date), Month(Date) + (AdM - 1), MyD)
>　 If Day(CkD) < MyD Then
>　　　MsgBox MyD & " 日は存在しません", 48
>　 Else
>　　　Application.EnableEvents = False
>　　　With Target
>　　　　 .Clear
>　　　　 .NumberFormat = "ge.mm.dd"
>　　　　 .Value = SetD
>　　　End With
>　　　Application.EnableEvents = True
>　 End If
>End Sub
>
>Private Sub Worksheet_SelectionChange(ByVal Target As Range)
>　 With Target
>　　　If Intersect(.Cells, Range("B20:B350")) Is _
>　　　 Nothing Then Exit Sub
>　　　If IsDate(.Value) Then .Clear
>　 End With
>End Sub


	【46493】Re:日付記入について教えてください

Kein - 07/2/5(月) 15:23 -


	引用なし

	パスワード

>初入力時はM33.01.20と表示
こちらでは正しくH19になっていますが・・。
いずけにせよ、セル選択イベントと入力イベントで制御するのは厄介なので、
目的の範囲内のセルを一つ選んで右クリックしたとき、数値を入力する
フォームを出す、というやり方にしてみましょう。
現在シートモジュールに入れているイベントマクロは削除してから、以下を入れて
下さい。これだと書式が消えることはありません。

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, _
Cancel As Boolean)
　 Dim MyD As Integer, AdM As Integer
　 Dim CkD As Date, SetD As Date
　 Const Pmt As String = "日を 1～31 までの数値で入力して下さい"
　
　 With Target
　　　If Intersect(.Cells, Range("B20:B350")) Is _
　　　 Nothing Then Exit Sub
　　　If .Count > 1 Then Exit Sub
　 End With
　 Cancel = True
　 Do
　　　MyD = Application.InputBox(Pmt, Type:=1)
　　　If MyD = False Then Exit Sub
　 Loop While MyD < 1 Or MyD > 31
　 If Day(Date) >= 23 Then
　　　AdM = 2
　 Else
　　　AdM = 1
　 End If
　 CkD = DateSerial(Year(Date), Month(Date) + AdM, 0)
　 SetD = DateSerial(Year(Date), Month(Date) + (AdM - 1), MyD)
　 If Day(CkD) < MyD Then
　　　MsgBox MyD & " 日は存在しません", 48
　 Else
　　　With Target
　　　　 .NumberFormat = "ge.mm.dd"
　　　　 .Value = SetD
　　　End With
　 End If
End Sub


	【46494】Re:日付記入について教えてください

Kein - 07/2/5(月) 15:24 -


	引用なし

	パスワード

>いずけにせよ
↓

いずれにせよ


	【46499】Re:日付記入について教えてください

takashi - 07/2/5(月) 15:54 -


	引用なし

	パスワード

▼へっぽこさん：
ありがとうございます。
シート上に数字データのセルあるため
範囲限定しないと難しいのですが・・・

>横からスミマセン。
>
>Private Sub Worksheet_Change(ByVal Target As Range)
>　　Application.EnableEvents = False
>　　If Day(Date) >= 23 Then
>　　　　Target.Value = DateSerial(Year(Date), Month(Date) + 1, Day(Target.Value2) + 1)
>　　Else
>　　　　Target.Value = DateSerial(Year(Date), Month(Date), Day(Target.Value2) + 1)
>　　End If
>　　Application.EnableEvents = True
>End Sub
>
>というのはどうでしょうか？
>
>※B20:B350以内の変更だったら？とか入力されたのが数字でなかったら？
>　は対応しておりません。


	【46501】Re:日付記入について教えてください

takashi - 07/2/5(月) 16:02 -


	引用なし

	パスワード

Keinさん
いろいろ考えていただきありがとうございました。
［46488］はセルを戻した時に消える現象はないですか。

>いずれにせよ、セル選択イベントと入力イベントで制御するのは厄介なので、
やはり上記はむずかしいのですか。？
右クリック方法はうまく出来ましたが・・・
簡単に入力できればとの思いで投稿したものですから


	【46503】Re:日付記入について教えてください

へっぽこ - 07/2/5(月) 16:07 -


	引用なし

	パスワード

>範囲限定しないと難しいのですが・・・

範囲限定はkeinさんの
　 If Intersect(Target, Range("B20:B350")) Is _
　　 Nothing Then Exit Sub
を流用すれば済むから書くまでもないなと思ったのですが。

２回入力するとどうなるかを見てほしかったのですが…


	【46505】Re:日付記入について教えてください

takashi - 07/2/5(月) 16:19 -


	引用なし

	パスワード

▼へっぽこさん：
そういうことでしたか勘違いしました
テスト結果ですが一度delすると2007/3/3が
表示したままになりました？
２度目も20で表示できましたよ
ありがとうございます。
3/3はdelキーできえませんが？

>>範囲限定しないと難しいのですが・・・
>
>範囲限定はkeinさんの
>　 If Intersect(Target, Range("B20:B350")) Is _
>　　 Nothing Then Exit Sub
>を流用すれば済むから書くまでもないなと思ったのですが。
>
>２回入力するとどうなるかを見てほしかったのですが…


	【46506】Re:日付記入について教えてください

Kein - 07/2/5(月) 16:30 -


	引用なし

	パスワード

セル入力イベントに拘るなら、へっぽこさんのValue2プロパティでうまくいく
ようですから、そちらを使う線で進めて下さい。注意点は
DateSerial関数の引数には、あり得ない日付が使えてしまうということ。
例えば DateSerial(2007, 1, 33) と入れてみて下さい。それをちゃんと制御すれば
希望するものができそうですね。


	【46507】Re:日付記入について教えてください

takashi - 07/2/5(月) 16:39 -


	引用なし

	パスワード

Keinさん
本当にありがとうございました。
いろいろ試してみます。
お世話様でした、またお願いします。


	【46508】Re:日付記入について教えてください

へっぽこ - 07/2/5(月) 16:40 -


	引用なし

	パスワード

DELキー→3/3を防ぐために

Private Sub Worksheet_Change(ByVal Target As Range)
　　If IsNumeric(Target.Value) And Target.Value <> "" Then '←追加
　　　　Application.EnableEvents = False
　　　　If Day(Date) >= 23 Then
　　　　　　Target.Value = DateSerial(Year(Date), Month(Date) + 1, Day(Target.Value2) + 1)
　　　　Else
　　　　　　Target.Value = DateSerial(Year(Date), Month(Date), Day(Target.Value2) + 1)
　　　　End If
　　　　Application.EnableEvents = True
　　End If '←追加
End Sub

としてみました。

どうやら、DELキーを押す→Target.Valueの値がEmptyになる→Day(Target.Value)=30になる
30+1で31→DateSerial(2007,2,31)=2007/3/3になる
という状況が発生するようです。


	【46513】Re:日付記入について教えてください

takashi - 07/2/5(月) 17:06 -


	引用なし

	パスワード

▼へっぽこさん：
ありがとうございます。
Keinさんの時と同様
２回目の入力では
１度消して２度目の入力時
1900/1/20を表示してしまいます。
Private Sub Worksheet_Change(ByVal Target As Range)
　 With Target
　　　If Intersect(.Cells, Range("B20:B350")) Is _
　　　 Nothing Then Exit Sub
　 If IsNumeric(Target.Value) And Target.Value <> "" Then

　　Application.EnableEvents = False
　　
　　If Day(Date) >= 23 Then
　　　　Target.Value = DateSerial(Year(Date), Month(Date) + 1, Day(Target.Value2) + 1)
　　Else
　　　　Target.Value = DateSerial(Year(Date), Month(Date), Day(Target.Value2) + 1)
　　End If
　　Application.EnableEvents = True
　　
　　End If
　 End With
End Sub

>DELキー→3/3を防ぐために
>
>Private Sub Worksheet_Change(ByVal Target As Range)
>　　If IsNumeric(Target.Value) And Target.Value <> "" Then '←追加
>　　　　Application.EnableEvents = False
>　　　　If Day(Date) >= 23 Then
>　　　　　　Target.Value = DateSerial(Year(Date), Month(Date) + 1, Day(Target.Value2) + 1)
>　　　　Else
>　　　　　　Target.Value = DateSerial(Year(Date), Month(Date), Day(Target.Value2) + 1)
>　　　　End If
>　　　　Application.EnableEvents = True
>　　End If '←追加
>End Sub
>
>としてみました。
>
>どうやら、DELキーを押す→Target.Valueの値がEmptyになる→Day(Target.Value)=30になる
>30+1で31→DateSerial(2007,2,31)=2007/3/3になる
>という状況が発生するようです。


	【46515】Re:日付記入について教えてください

へっぽこ - 07/2/5(月) 17:57 -


	引用なし

	パスワード

Private Sub Worksheet_Change(ByVal Target As Range)
　　If (IsNumeric(Target.Value) Or IsDate(Target.Value)) And Target.Value <> "" Then '←こうかな？
　　　　Application.EnableEvents = False
　　　　If Day(Date) >= 23 Then
　　　　　　Target.Value = DateSerial(Year(Date), Month(Date) + 1, Day(Target.Value2) + 1)
　　　　Else
　　　　　　Target.Value = DateSerial(Year(Date), Month(Date), Day(Target.Value2) + 1)
　　　　End If
　　　　Application.EnableEvents = True
　　End If
End Sub

これではどうでしょう？
（←こうかな？　という感じに変えてみました）


	【46516】Re:日付記入について教えてください

takashi - 07/2/5(月) 18:10 -


	引用なし

	パスワード

▼へっぽこさん：
ありがとうございました。
思い通りです。感謝です～
こうかな？意味これから理解してみます。
何度も修正いただき本当にありがとうございました。

>Private Sub Worksheet_Change(ByVal Target As Range)
>　　If (IsNumeric(Target.Value) Or IsDate(Target.Value)) And Target.Value <> "" Then '←こうかな？
>　　　　Application.EnableEvents = False
>　　　　If Day(Date) >= 23 Then
>　　　　　　Target.Value = DateSerial(Year(Date), Month(Date) + 1, Day(Target.Value2) + 1)
>　　　　Else
>　　　　　　Target.Value = DateSerial(Year(Date), Month(Date), Day(Target.Value2) + 1)
>　　　　End If
>　　　　Application.EnableEvents = True
>　　End If
>End Sub
>
>これではどうでしょう？
>（←こうかな？　という感じに変えてみました）


	【46517】Re:日付記入について教えてください

へっぽこ - 07/2/5(月) 18:26 -


	引用なし

	パスワード

ちょっとボケッとしてました。

Private Sub Worksheet_Change(ByVal Target As Range)
　　If IsNumeric(Target.Value2) And Target.Value2 <> "" Then '←Value2にしてIsDateを消した
　　　　Application.EnableEvents = False
　　　　If Day(Date) >= 23 Then
　　　　　　Target.Value = DateSerial(Year(Date), Month(Date) + 1, Day(Target.Value2) + 1)
　　　　Else
　　　　　　Target.Value = DateSerial(Year(Date), Month(Date), Day(Target.Value2) + 1)
　　　　End If
　　　　Application.EnableEvents = True
　　End If
End Sub

こうしたほうがちょっとスッキリだと思います。


	【46520】Re:日付記入について教えてください

takashi - 07/2/5(月) 20:54 -


	引用なし

	パスワード

▼へっぽこさん：
Private Sub Worksheet_Change(ByVal Target As Range)
　　　 With Target
　　　If Intersect(.Cells, Range("C28:C500")) Is _
　　　 Nothing Then Exit Sub
　　If IsNumeric(Target.Value2) And Target.Value2 <> "" Then
　　　　★↑ココが『型が一致しません』と出てしまうのですが・・・
出る原因として次の動作をしたときに出ます
例えばC30:C35を範囲指定して一気にDELキーを押し消そうとした場合に
この症状が出ます。原因解りますか？

'←Value2にしてIsDateを消した

　　　　Application.EnableEvents = False
　　　　If Day(Date) >= 23 Then
　　　　　　Target.Value = DateSerial(Year(Date), Month(Date) + 1, Day(Target.Value2) + 1)
　　　　Else
　　　　　　Target.Value = DateSerial(Year(Date), Month(Date), Day(Target.Value2) + 1)
　　　　End If
　　　　Application.EnableEvents = True
　 End If
End With
End Sub


	【46540】Re:日付記入について教えてください

へっぽこ - 07/2/6(火) 10:49 -


	引用なし

	パスワード

複数セルに一気に入力するケースを考慮してみました。

Private Sub Worksheet_Change(ByVal Target As Range)
　　Dim 各々のセル As Range

　　If Intersect(Target, Range("B20:B350")) Is Nothing Then
　　　　Exit Sub
　　End If
　　
　　Application.EnableEvents = False

　　'For Each を使ってIntersect(Target, Range("B20:B350"))の範囲内にあるセルを
　　'1つ1つ処理する。
　　For Each 各々のセル In Intersect(Target, Range("B20:B350"))
　　　　If IsNumeric(各々のセル.Value2) And 各々のセル.Value2 <> "" Then
　　　　　　If Day(Date) >= 23 Then
　　　　　　　　各々のセル.Value = DateSerial(Year(Date), Month(Date) + 1, Day(各々のセル.Value2) + 1)
　　　　　　Else
　　　　　　　　各々のセル.Value = DateSerial(Year(Date), Month(Date), Day(各々のセル.Value2) + 1)
　　　　　　End If
　　　　End If
　　Next
　　
　　Application.EnableEvents = True
End Sub

以下はテスト用のマクロですが…

Private Sub Worksheet_Change(ByVal Target As Range)
　　MsgBox TypeName(Target.Value)
End Sub

１つのセルに何か入力したり、ＤＥＬで消したりする場合と
複数セルに一気に何かした場合ではTaget.Value(Value2でも)の
型が変わってきてしまうのです。
（複数セルを一気に操作すると配列として扱う必要があります。）


	【46545】Re:日付記入について教えてください

takashi - 07/2/6(火) 12:16 -


	引用なし

	パスワード

▼へっぽこさん：
ありがとうございました。
完璧です。
>１つのセルに何か入力したり、ＤＥＬで消したりする場合と
>複数セルに一気に何かした場合ではTaget.Value(Value2でも)の
>型が変わってきてしまうのです。
>（複数セルを一気に操作すると配列として扱う必要があります。）
配列式ですかVBA難しいですね・・・


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

6222 / 13644 ﾂﾘｰ

←次へ　｜　前へ→

ページ：

┃

記事番号：

(SS)C-BOARD v3.8 is Free