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

帖子: 522
主題: 36
精華: 1
積分: 603
點名: 0
作業系統: win xp sp3
軟體版本: Office 2003
閱讀權限: 50
性別: 男
註冊時間: 2012-12-13
最後登錄: 2021-7-11

1^# 跳轉到 »

發表於 2016-1-8 15:39 | 顯示全部帖子

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

帖子: 522
主題: 36
精華: 1
積分: 603
點名: 0
作業系統: win xp sp3
軟體版本: Office 2003
閱讀權限: 50
性別: 男
註冊時間: 2012-12-13
最後登錄: 2021-7-11

2^#

發表於 2016-1-8 15:42 | 顯示全部帖子

本帖最後由 yen956 於 2016-1-8 15:55 編輯

試試看!!

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

複製代碼

帖子: 522
主題: 36
精華: 1
積分: 603
點名: 0
作業系統: win xp sp3
軟體版本: Office 2003
閱讀權限: 50
性別: 男
註冊時間: 2012-12-13
最後登錄: 2021-7-11

3^#

發表於 2016-1-9 12:19 | 顯示全部帖子

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

帖子: 522
主題: 36
精華: 1
積分: 603
點名: 0
作業系統: win xp sp3
軟體版本: Office 2003
閱讀權限: 50
性別: 男
註冊時間: 2012-12-13
最後登錄: 2021-7-11

4^#

發表於 2016-1-9 14:15 | 顯示全部帖子

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

帖子: 522
主題: 36
精華: 1
積分: 603
點名: 0
作業系統: win xp sp3
軟體版本: Office 2003
閱讀權限: 50
性別: 男
註冊時間: 2012-12-13
最後登錄: 2021-7-11

5^#

發表於 2016-1-11 12:30 | 顯示全部帖子

回復 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