| |
▼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
|
|
takashi
- 07/2/5(月) 14:45 -
