註冊
登錄
首頁
論壇版規
禁止列表
說明
地圖
數位書香
私人消息 (0)
公共消息 (0)
論壇任務 (0)
系統消息 (0)
好友消息 (0)
帖子消息 (0)
麻辣家族討論版版
»
Excel程式區
» 如何利用VBA觸發儲存格產生日期.時間
 
1
2
返回列表
下一主題
上一主題
發帖
如何利用VBA觸發儲存格產生日期.時間
yen956
發短消息
加為好友
yen956
當前離線
UID
12058
帖子
522
主題
36
精華
1
積分
603
金錢
603
點名
0
作業系統
win xp sp3
軟體版本
Office 2003
閱讀權限
50
性別
男
在線時間
319 小時
註冊時間
2012-12-13
最後登錄
2021-7-11
高中生
帖子
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
複製代碼
下載
(26.54 KB)
2016-1-8 15:55
TOP
yen956
發短消息
加為好友
yen956
當前離線
UID
12058
帖子
522
主題
36
精華
1
積分
603
金錢
603
點名
0
作業系統
win xp sp3
軟體版本
Office 2003
閱讀權限
50
性別
男
在線時間
319 小時
註冊時間
2012-12-13
最後登錄
2021-7-11
高中生
帖子
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的
TOP
man65boy
發短消息
加為好友
man65boy
當前離線
UID
4388
帖子
169
主題
39
精華
0
積分
252
金錢
252
點名
0
作業系統
XP
軟體版本
2003
閱讀權限
20
在線時間
572 小時
註冊時間
2011-4-17
最後登錄
2020-7-17
中學生
帖子
169
主題
39
精華
0
積分
252
點名
0
作業系統
XP
軟體版本
2003
閱讀權限
20
註冊時間
2011-4-17
最後登錄
2020-7-17
3
#
發表於 2016-1-8 15:29
|
只看該作者
回復
2#
ML089
真多謝ML089老師的回答,如果輸入日期.時間後,我在手動更改起始時間或結束時間,可否讓統計的"分",也同時同步變更加總,麻煩老師了^^
TOP
ML089
發短消息
加為好友
ML089
當前離線
UID
3671
帖子
2025
主題
13
精華
0
積分
2053
金錢
2053
點名
0
作業系統
WIN7
軟體版本
Office2007
閱讀權限
100
性別
男
來自
台北市
在線時間
2405 小時
註冊時間
2011-3-2
最後登錄
2024-3-14
版主
帖子
2025
主題
13
精華
0
積分
2053
點名
0
作業系統
WIN7
軟體版本
Office2007
閱讀權限
100
性別
男
來自
台北市
註冊時間
2011-3-2
最後登錄
2024-3-14
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 三鍵輸入公式
TOP
靜思自在 :
並非有錢魷是快樂,問心無愧心最安。
 
1
2
返回列表
下一主題
上一主題
Excelㄧ般區
EXCEL專屬討論區
Excelㄧ般區
Excel程式區
進階應用專區
OFFICE 系列
Word
PowerPoint
Access
Office不分區
程式語言
VB 與 VB.Net
C 與 C#
Java 與 J#
程式設計不分區
資料庫
ORACLE
My SQL
MS SQL
網頁設計
ASP 與 ASP.NET
PHP
PHP+MySQL 入門實作
JavaScript
FLASH / ActionScript
HTM/ HTML/ CSS
網頁設計不分區
電腦與作業系統
電腦各種硬體討論
一般電腦軟體討論
論壇事務
管理公告
投訴反映
新手測試
愛 • 生活
公益佈告欄
生活與感動
[收藏此主題]
[關注此主題的新回復]
[通過 QQ、MSN 分享給朋友]
申請友情鏈接
Facebook粉絲