VBA EXCEL 指定数字で表示

質問

VBAで以下のことをするには、どうすればよいでしょうか。
・D列に
1と入力された場合は、同じ行のF列は9：00と表示
2と入力された場合は、同じ行のF列は10：00と表示
3と入力された場合は、同じ行のF列は11：00と表示
・
・
※但し、以下の場合は、該当の数字が入力されない。
(1)現時間よりも、表示されるべき時間が遅い時間の場合。
→現時間が10：15の場合、3と入力されても11：00と表示されない。
(2)F列に予め、○と入力されている場合、

なにとぞ、よろしくお願い致します。

回答No.2

keithin · ベストアンサー

シート名タブを右クリックしてコードの表示を選ぶ
現れたシートに下記をコピー貼り付ける

option base 1
private sub Worksheet_Change(byval Target as excel.range)
　dim h as range
　dim a as variant
　a = array("9:0", "10:0", "11:0")　’１から３
　on error resume next

　for each h in application.intersect(target, range("D:D"))
　　if cells(h.row, "F") <> "○" then
　　if 1=< h.value and h.value <= 3 then　　’１から３
　　if time >= timevalue(a(h.value)) then
　　　cells(h.row, "F") = a(h.value)
　　end if
　　end if
　　end if
　next
end sub

ファイルメニューから終了してエクセルに戻る
Ｄ列に１，２，３を記入する。

回答No.5

MarcoRossiItaly

「すぐに回答を！」と書いてあるにもかかわらず、質問者からは、すぐに反応がないみたいですね。この質問はもう見ないことにします。

回答No.4

MarcoRossiItaly

下のコード例では、次の条件を全て満たす動作となります。

(1) D 列に小数が記入された場合、それを四捨五入により整数化。
(2)四捨五入により得た整数が -9 以下である場合は何もせず、-8 以上の場合のみ整数と時刻を D・F 列のセルに記入。
(3)現在時刻が 10:15 であり、四捨五入により 3 となる値を D 列に記入した場合、10:00 と 11:00 のいずれもセルには記入せず、何もしない。

Private Sub Worksheet_Change(ByVal Target As Range)
　　If Intersect(Target, Columns("d:d")) Is Nothing Or Target.Rows.Count > 999 Then Exit Sub
　　Dim c As Range, t As Double, n As Long
　　For Each c In Intersect(Target, Columns("d:d"))
　　　　With c
　　　　　　If IsNumeric(.Value) And .Value <> "" And Cells(.Row, "f").Value <> "○" Then
　　　　　　　　n = Round(.Value)
　　　　　　　　If n >= -8 Then
　　　　　　　　　　t = TimeSerial(n + 8, 0, 0)
　　　　　　　　　　If t <= Time Then
　　　　　　　　　　　　Cells(.Row, "d").Value = n
　　　　　　　　　　　　Cells(.Row, "f").Value = t
　　　　　　　　　　End If
　　　　　　　　End If
　　　　　　End If
　　　　End With
　　Next c
End Sub

回答No.3

tom04

No.1です。

書き忘れていました。
F列の表示形式は　時刻　にしておいてください。m(_ _)m

回答No.1

tom04

こんばんは！

D列は数値の場合、必ず整数が入るとします。
シートモジュールです。

Private Sub Worksheet_Change(ByVal Target As Range)
Dim myTime As Double
If Intersect(Target, Range("D:D")) Is Nothing Or Target.Count > 1 Then Exit Sub
With Target
If IsNumeric(.Value) Then
myTime = TimeSerial(.Value + 8, 0, 0)
If myTime < TimeValue(Now()) And Cells(.Row, "F") = "○" Then
Cells(.Row, "F") = myTime
End If
End If
End With
End Sub

こんな感じで良いのでしょうか？m(_ _)m