如何利用VBA觸發儲存格產生日期.時間

man65boy

請教老師們如何在工作表觸發儲存格後，對應的欄位產生日期.時間
1.B欄輸入文字後，ｄ欄對應欄位就顯現日期.時間，B欄沒輸入，
   D欄對應欄位就反白。
2.C欄輸入文字後，E欄對應欄位就顯現日期.時間，C欄沒輸入，
   E欄對應欄位就反白。
3.F欄為合計計算時間欄位。

謝謝老師們幫忙！
附檔: 20160108.rar (16.42 KB)

下載次數: 22

2016-1-8 10:41

man65boy

回復 13# yen956


  謝謝yen956大大的幫忙，真的很好用，也謝謝ML089大大，感謝^^

yen956

回復 12# man65boy
試試看:
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Lst As Integer, r As Integer, Rng As Range
    Lst = [A65536].End(xlUp).Row    '取得 欄A 最下面非空白格的列號
    Set Rng = [B2].Resize(Lst - 1, 4)   '設定Worksheet_Change觸動範圍為[B2:Dxx], xx=Lst(列號)
    If Target.Count > 2 Then Exit Sub   '如果一次改變多格則沒作用
    If Intersect(Target, Rng) Is Nothing Then Exit Sub   '如果改變的儲存格不在預計範圍內則沒作用
    r = Target.Row
    '如果改變的儲存格是 B欄 或 C欄, 則
    If Target.Column = 2 Or Target.Column = 3 Then
        '★如果 Target 為空白, 則
        If Target = "" Then
            Target.Offset(0, 2) = ""                      '清除同列右邊兩欄的Cell
            Target.Offset(0, 2).Interior.ColorIndex = 35  '並反白
            Target.Cells(r, 6) = ""              '並清除同列的[Fxx]
        '★否則
        Else
            '如果同列右邊兩欄的Cell為空白, 則填入現在時間, 不是空白, 則不填
            If Target.Offset(0, 2) = "" Then
                Target.Offset(0, 2) = Now                         '填入現在時間
                Target.Offset(0, 2).Interior.ColorIndex = xlNone  '且取消反白
            End If
        End If
    End If
        
    '如果 起始時間 及 結束時間 不是空白, 則在 [Fxx] 計算時差(以分鐘為單位)
    If Application.Count(Cells(r, 4), Cells(r, 5)) = 2 Then
        Cells(r, 6) = Int((Cells(r, 5) - Cells(r, 4)) * 24 * 60)
    End If
End Sub

man65boy

回復 11# yen956

   拍事，小弟沒寫明白!
    假設B5輸入人員後，D5跑出"起始時間"，C5輸入人員後，E5跑出結束時間，之後VBA語法已經把F5做統計了，我在隨意更改起始時間D5，F5的統計時間就不會再更改了，是這個意思。

yen956

回復 7# man65boy
"但如果手動更改時間的話，共計"分"可否同時更改數據"
看不懂你的需求是什麼?

yen956

回復 6# ML089
謝謝大大的指導!!
尤其是用
Range("F" & .Row) = "=IF(COUNT(RC4:RC5)=2,INT((RC5-RC4)*24*60),"""")"
的使用, 可以簡化不少 If A and B then ... 的寫法, 非常實用, 收下, 謝謝

ML089

回復 8# man65boy

這是 相對位置公式
Range("F" & .Row) = "=IF(COUNT(RC[-2]:RC[-1])=2,INT((RC[-1]-RC[-2])*24*60),"""")"

這是 絕對位置公式
Range("F" & .Row) = "=IF(COUNT(RC4:RC5)=2,INT((RC5-RC4)*24*60),"""")"

man65boy

回復 6# ML089


    謝謝ML089大大的回答，給小弟多了一項解題的答案!真感謝^^

man65boy

回復 5# yen956

謝謝yen956大大的回答，但如果手動更改時間的話，共計"分"可否同時更改數據，謝謝你!

ML089

回復 3# man65boy

F欄直接用公式帶入

Private Sub Worksheet_Change(ByVal Target As Range)
With Target
      If .Count > 1 Then Exit Sub
      If Intersect(Union([B:B], [C:C]), .Cells) Is Nothing Then Exit Sub
      Application.EnableEvents = False
      .Offset(0, 2).Value = Now()
      Range("F" & .Row) = "=IF(COUNT(RC4:RC5)=2,INT((RC5-RC4)*24*60),"""")"
      Application.EnableEvents = True
End With
End Sub

補充：
這是 相對位置公式
Range("F" & .Row) = "=IF(COUNT(RC[-2]:RC[-1])=2,INT((RC[-1]-RC[-2])*24*60),"""")"

這是 絕對位置公式
Range("F" & .Row) = "=IF(COUNT(RC4:RC5)=2,INT((RC5-RC4)*24*60),"""")"