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