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

man65boy

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

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

下載次數: 22

2016-1-8 10:41

ML089

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2. Dim r%, xD As Range, xE As Range, xF As Range
   
3. With Target
   
4.       If .Count > 1 Then Exit Sub
   
5.       If Intersect(Union([B:B], [C:C]), .Cells) Is Nothing Then Exit Sub
   
6.       Application.EnableEvents = False
   
7.       .Offset(0, 2).Value = Now()
   
8.       r = .Row() - 1: Set xD = [D1].Offset(r, 0): Set xE = [E1].Offset(r, 0): Set xF = [F1].Offset(r, 0)
   
9.       If Application.Count(xD, xE) = 2 Then xF = Int((xE - xD) * 24 * 60)
   
10.       Application.EnableEvents = True
    
11. End With
    
12. End Sub

複製代碼

man65boy

回復 2# ML089

真多謝ML089老師的回答，如果輸入日期.時間後，我在手動更改起始時間或結束時間，可否讓統計的"分"，也同時同步變更加總，麻煩老師了^^

yen956

回復 2# ML089
感謝 ML089超版的VBA的

yen956

試試看!!

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2.     Dim Lst As Integer, r As Integer
   
3.     Lst = [A65536].End(xlUp).Row
   
4.     If Target.Count > 2 Then Exit Sub  '如果一次改變多格則沒作用
   
5.     r = Target.Row
   
6.     If r > Lst Then Exit Sub  '如果最下面的部門為空白則沒作用
   
7.    
   
8.     '如果改變的儲存格不在 B欄 或 C欄 則沒作用
   
9.     If Target.Column <> 2 And Target.Column <> 3 Then Exit Sub
   
10.    
    
11.     '如果 Target 為空白, 則隔兩欄反白, 並清除[Fxx]
    
12.     If Target = "" Then
    
13.         Target.Offset(0, 2) = ""
    
14.         Target.Offset(0, 2).Interior.ColorIndex = 35
    
15.         Cells(r, 6) = ""
    
16.     Else
    
17.         Target.Offset(0, 2) = Now    '否則隔兩欄取消反白, 填入現在時間
    
18.         Target.Offset(0, 2).Interior.ColorIndex = xlNone
    
19.     End If
    
20.         
    
21.     '如果 [Dxx] 及 [Exx] 不是空白, 在 [Fxx] 計算時差(以分鐘為單位)
    
22.     If Cells(r, 4) <> "" And Cells(r, 5) <> "" Then
    
23.         Cells(r, 6) = Int((Cells(r, 5) - Cells(r, 4)) * 24 * 60)
    
24.     End If
    
25. End Sub

複製代碼

下載 (26.54 KB)

2016-1-8 15:55

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),"""")"

man65boy

回復 5# yen956

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

man65boy

回復 6# ML089


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

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),"""")"

yen956

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