如何利用VBA觸發儲存格產生日期.時間 - Excel程式區 - 麻辣家族討論版版

麻辣家族討論版版 » Excel程式區 » 如何利用VBA觸發儲存格產生日期.時間

返回列表下一主題上一主題發帖

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

高中生 Rank: 3 Rank: 3

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

5^# 跳轉到 »

發表於 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

複製代碼

高中生 Rank: 3 Rank: 3

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

4^#

發表於 2016-1-8 15:39 | 只看該作者

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

中學生 Rank: 2

帖子: 169
主題: 39
精華: 0
積分: 252
點名: 0
作業系統: XP
軟體版本: 2003
閱讀權限: 20
註冊時間: 2011-4-17
最後登錄: 2020-7-17

2012龍年全勤獎章 2011兔年全勤獎章

3^#

發表於 2016-1-8 15:29 | 只看該作者

回復 2# ML089

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

版主 Rank: 7 Rank: 7 Rank: 7

帖子: 2025
主題: 13
精華: 0
積分: 2053
點名: 0
作業系統: WIN7
軟體版本: Office2007
閱讀權限: 100
性別: 男
來自: 台北市
註冊時間: 2011-3-2
最後登錄: 2024-3-14

論壇榮譽勳章論壇贊助勳章熱烈參與勳章 2014馬年全勤獎章 2015羊年全勤獎章 2016猴年全勤獎章

2^#

發表於 2016-1-8 14:54 | 只看該作者

Private Sub Worksheet_Change(ByVal Target As Range)
Dim r%, xD As Range, xE As Range, xF 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()
r = .Row() - 1: Set xD = [D1].Offset(r, 0): Set xE = [E1].Offset(r, 0): Set xF = [F1].Offset(r, 0)
If Application.Count(xD, xE) = 2 Then xF = Int((xE - xD) * 24 * 60)
Application.EnableEvents = True
End With
End Sub

複製代碼

{...} 表示需要用 CTRL+SHIFT+ENTER 三鍵輸入公式

靜思自在 : 道德是提昇自我的明燈，不該是呵斥別人的鞭子。

返回列表下一主題上一主題