1234
返回列表 上一主題 發帖

[發問] 能否幫我看看如何將此程式更改成以 小時 分鐘 秒數 計算(已解決)

vpower

帖子
155 
主題
56 
精華
0 
積分
242 
點名
0  
作業系統
WinXP 
軟體版本
專業版2002 
閱讀權限
0 
註冊時間
2010-5-29 
最後登錄
2011-7-18 
1# 跳轉到 » 正序看帖
打印
tT
發表於 2011-5-12 22:35 | 只看該作者

[發問] 能否幫我看看如何將此程式更改成以 小時 分鐘 秒數 計算(已解決)

本帖最後由 vpower 於 2011-5-24 09:23 編輯

點選下方下載檔案或觀看下方的解說:
http://naturefruit.myweb.hinet.net/Day.xls

A      B     C     D
1
2 約會            2011/5/11
3 吃飯            2001/5/10
4
  1. For J1 = 2 To Sheets("Sheet1").[C65536].End(xlUp).Row
  2. I1 = DateDiff("D", Date, Range("C" & J1))
  3. If I1 < 0 Then S1 = "已經超過了" & " " & (-1) * (I1) & " 天"
  4. If S1 <> "" Then S2 = S2 & "距離" & " " & Sheets("Sheet1").Range("A" & J1) & " 的時間" & S1 & vbNewLine
  5. S1 = "": I1 = 0
  6. Next
  7. If S2 <> "" Then MsgBox S2
  8. S2 = ""
複製代碼
以上為一個以 天 計算的程式，以上程式執行後，會跳出一個視窗，顯示如下

距離 約會 的時間已經超過 1 天
距離 吃飯 的時間已經超過 6 天


我希望能更改成以 小時 分鐘 秒數 計算

所以我會先D欄儲存格的屬性更改成自訂 mm/dd hh:mm:ss

然後輸入時間,顯示如下:

距離 約會 的時間已經超過 1 小時
距離 吃飯 的時間已經超過 6 小時

或

距離 約會 的時間已經超過 1 分鐘
距離 吃飯 的時間已經超過 6 分鐘

或

把"已經超過"變成"還有"

以上三個問題，謝謝各位大大了!
收藏 分享

vpower

帖子
155 
主題
56 
精華
0 
積分
242 
點名
0  
作業系統
WinXP 
軟體版本
專業版2002 
閱讀權限
0 
註冊時間
2010-5-29 
最後登錄
2011-7-18 
34#
發表於 2011-6-9 09:37 | 只看該作者
本帖最後由 vpower 於 2011-6-9 10:39 編輯
回復  vpower
試試看
GBKEE 發表於 2011-5-19 17:49



    版主您好,又來打擾您,請問一下
這檔案經常在開啟後出現自動關閉,或是操作到一半自動關閉,不知道是什麼原因呢?
--------------------------------------------------------------------------------------
如果我想把 已過  和   還有 移除,改成時間到了出現該事件即可,我該怎麼修改呢?
例如,事件約會A設定時間是5分鐘以前,時間剩下5分鐘的事件顯示出來即可,
不要全部事件都顯示,已過XX天、還有XX天這些都不顯示,

請問按下提醒表單後,他把所輸入的值是送到哪裡呢?
我找了一下,不知該如何修改成固定時間,也就是我直接輸入在VBA內.
只有看到這段
  1. Private Sub 提醒(Msg As Boolean)     '設定自動於時間到提醒
  2.     Dim J1%
  3.     提醒Msg = False
  4.     With Sheets("Sheet1")
  5.         For J1 = 2 To .[C65536].End(xlUp).Row
  6.             If Range("C" & J1) <> "" And IsDate(Range("C" & J1)) Then
  7.                 If Range("C" & J1) > Now Then
  8.                     提醒Msg = True
  9.                     If Msg = True Then Application.OnTime Range("C" & J1) - TheTime, "Sheet1.CommandButton1_Click"                  '設定時間提醒
  10.                 End If
  11.             End If
  12.         Next
  13.     End With
  14. End Sub
複製代碼
好像沒有地方可以設定"A"這個欄位,萬一事件不放在A欄,我該如何指向A?

TOP

vpower

帖子
155 
主題
56 
精華
0 
積分
242 
點名
0  
作業系統
WinXP 
軟體版本
專業版2002 
閱讀權限
0 
註冊時間
2010-5-29 
最後登錄
2011-7-18 
33#
發表於 2011-5-23 00:32 | 只看該作者
本帖最後由 vpower 於 2011-6-9 09:38 編輯

已無提問。

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
32#
發表於 2011-5-22 14:19 | 只看該作者
回復 31# vpower
**** 29樓,31樓是兩碼事*****
29樓
  請幫我看一下,下面這個的"D",功能是什麼?如果我沒用到,改如何刪除改寫
                 I1 = DateDiff("D", Date, Range("C" & J1))的"D"


31樓
可是我的"D"欄沒有放日期讓他比較,所以想節省他,不用讓他每次判斷"D"欄.  

請問是工作表"D"欄 嗎? 你的程式碼沒有比對到"D"欄

你有看 VBA 中的DateDiff 說明嗎?
I1 = DateDiff("D", Date, Range("C" & J1))的"D" 此函數DateDiff 表示兩個日期間相差的時間間隔單位數目
D是天的單位, 所以I1為傳回天數的變數

TOP

vpower

帖子
155 
主題
56 
精華
0 
積分
242 
點名
0  
作業系統
WinXP 
軟體版本
專業版2002 
閱讀權限
0 
註冊時間
2010-5-29 
最後登錄
2011-7-18 
31#
發表於 2011-5-22 14:00 | 只看該作者
回復 30# GBKEE


    可是我的"D"欄沒有放日期讓他比較,所以想節省他,不用讓他每次判斷"D"欄.

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
30#
發表於 2011-5-22 08:14 | 只看該作者
回復 29# vpower
可以詳看 VBA  DateDiff  說明
傳回一 Variant (Long) 的值，表示兩個日期間相差的時間間隔單位數目

TOP

vpower

帖子
155 
主題
56 
精華
0 
積分
242 
點名
0  
作業系統
WinXP 
軟體版本
專業版2002 
閱讀權限
0 
註冊時間
2010-5-29 
最後登錄
2011-7-18 
29#
發表於 2011-5-20 15:46 | 只看該作者
本帖最後由 vpower 於 2011-5-20 22:38 編輯

請幫我看一下,下面這個的"D",功能是什麼?如果我沒用到,改如何刪除改寫
I1 = DateDiff("D", Date, Range("C" & J1))的"D"
.
  1. Private Sub Workbook_Open()
  2.     Dim J1%, S1$, S2$
  3.     With Sheet1.WindowsMediaPlayer1     '加入MediaPlayer播放音樂
  4.         .URL = "D:\數羊歌.MP3"  '請修改音樂檔案
  5.         .Visible = False
  6.         .Controls.stop
  7.     End With
  8.     For J1 = 2 To Sheets("Sheet1").[C65536].End(xlUp).Row
  9.         If Range("C" & J1) <> "" And IsDate(Range("C" & J1)) Then
  10.         ''''''''''''''''''''''''''''''''''''''''''''''''
  11.             I1 = DateDiff("D", Date, Range("C" & J1))
  12.             If I1 >= 0 And I1 <= 90 Then S1 = "在90天內過期"
  13.             If I1 <= 60 Then S1 = "在60天內過期"
  14.             If I1 <= 30 Then S1 = "在30天內過期"
  15.             If I1 < 0 Then S1 = "已過期" & (-1) * (I1) & "天"
  16.             If S1 <> "" Then S2 = S2 & Sheets("Sheet1").Range("A" & J1) & "-" & S1 & vbNewLine & vbNewLine
  17.             S1 = "": I1 = 0
  18.         '''''''''''''''''''''''''''''''''''''''''''
  19.         End If
  20.     Next
  21.     If S2 <> "" Then
  22.         With Sheet1.WindowsMediaPlayer1     '加入MediaPlayer播放音樂
  23.             .URL = "D:\數羊歌.MP3"  '請修改音樂檔案
  24.             .Visible = False
  25.             .Controls.Play          '播放音樂
  26.           ''''''''''''''''''''''''''''''''''''
  27.             MsgBox S2
  28.             .Controls.stop          '關閉音樂
  29.             '''''''''''''''''''''''''''''''''
  30.         End With
  31.     End If
  32.     'If S2 <> "" Then MsgBox S2 Else
  33. End Sub
複製代碼

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
28#
發表於 2011-5-20 09:00 | 只看該作者
本帖最後由 GBKEE 於 2011-5-20 09:05 編輯

回復 27# vpower
同一模組中不可有相同的程序名稱
測試2中保留原來的 Private Sub CommandButton1_Click() 我改為 Private Sub XXXXCommandButton1_Click()
所以
原來的Private Sub XXXXCommandButton1_Click()    還原成  Private Sub CommandButton1_Click()
之後要將原來的  Private Sub CommandButton1_Click()   改成  Private Sub XXXXCommandButton1_Click()  或可以刪掉

TOP

vpower

帖子
155 
主題
56 
精華
0 
積分
242 
點名
0  
作業系統
WinXP 
軟體版本
專業版2002 
閱讀權限
0 
註冊時間
2010-5-29 
最後登錄
2011-7-18 
27#
發表於 2011-5-20 08:31 | 只看該作者
回復 26# GBKEE


   發現不確定的名稱: CommandButton1_Click

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
26#
發表於 2011-5-20 06:41 | 只看該作者
本帖最後由 GBKEE 於 2011-5-20 06:52 編輯

回復 25# vpower
Private Sub XXXXCommandButton1_Click()    還原成  Private Sub CommandButton1_Click()
這段程式碼中  保留紅色部分 刪掉其餘
If S <> "" Then      
   With Sheet1.WindowsMediaPlayer1     '加入MediaPlayer播放音樂
         .URL = "D:\數羊歌.MP3"  '請修改音樂檔案                           
         .Visible = False                                                     
         .Controls.Play          '播放音樂                                             
         MsgBox S, , Format(Now, "dddddd  ttttt")                     
         .Controls.Stop          '關閉音樂                                 
    End With                                                                 
End If   
vbNewLine  或  Chr(10)   '加入空一行
Sub 事件() 已修改 請複製套入檔案中
  1. Private Sub 事件()
  2.     Dim TheDay#, Msg$, J1%, S$, Hh$, Mm$, Ss$, Form_Hight%
  3.     Dim H%
  4.     Me.Caption = Format(Now, "dddddd  ttttt")
  5.      For J1 = 2 To Sheets("Sheet1").[C65536].End(xlUp).Row
  6.         If Range("C" & J1) <> "" And IsDate(Range("C" & J1)) Then
  7.             TheDay = Now - Range("C" & J1).Value: Msg = " 時間 已過"
  8.             If Range("C" & J1) >= Now Then TheDay = Range("C" & J1) - Now: Msg = " 時間 還有"
  9.             If Abs(Int(TheDay)) > 0 Then
  10.               Mm = Format(Minute(TheDay), "00分鐘")
  11.               Ss = Format(Second(TheDay), "00秒")
  12.               Hh = Abs(Int(TheDay)) * 24 + Hour(TheDay) & "小時" + Mm + Ss
  13.             Else
  14.                 Hh = Format(TheDay, "hh小時mm分鐘ss秒")
  15.                 Hh = Replace(Hh, "00小時", "")
  16.             End If
  17.             Hh = Replace(Replace(Hh, "00分鐘", ""), "00秒", "")
  18.             S = IIf(S = "", "", S & vbNewLine) & "距離 " & Sheets("Sheet1").Range("A" & J1) & Msg & Hh & vbNewLine   '加入空一行
  19.             Form_Hight = Form_Hight + 2
  20.         End If
  21.     Next
  22.     H = 12
  23.     With Me
  24.         .Label1.Caption = S
  25.         .Label1.Height = H * Form_Hight + 5
  26.         .Height = .Label1.Height + (H * 2 + 15)
  27.     End With
  28.     If S = "" Then Unload Me: Exit Sub
  29. End Sub
複製代碼

TOP

        靜思自在 : 受人點水之恩，須當湧泉以報。
1234
返回列表 上一主題