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 分鐘

或

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

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

GBKEE

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

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

回復 1# vpower
  1. Private Sub CommandButton1_Click()
  2.     Dim TheDay#, Msg$, J1%, S$, D$, H$
  3.     For J1 = 2 To Sheets("Sheet1").[C65536].End(xlUp).Row
  4.         TheDay = Now - Range("C" & J1).Value: Msg = " 時間 已過"
  5.         If Range("C" & J1) >= Now Then TheDay = Range("C" & J1) - Now: Msg = " 時間 還有"
  6.         H = IIf(Abs(Int(TheDay)) > 0, Abs(Int(TheDay)) & "天", "") & Format(TheDay, "hh小時:mm分鐘:ss秒")
  7.         H = Replace(Replace(H, "00小時:", ""), "00分鐘:", "")
  8.         S = IIf(S = "", "", S & vbNewLine) & "距離 " & Sheets("Sheet1").Range("A" & J1) & Msg & H
  9.     Next
  10.     If S <> "" Then MsgBox S, , Format(Now, "dddddd ttttt")
  11. End Sub
複製代碼

TOP

vpower

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


    這位大大真的是又快又好..非常感謝..

可否再請教一個問題?
D是做什麼用的呢?
是否可以刪除呢?

還有發現一個小BUG,
A1=約會 C1=時間
A2=吃飯 C2=空值
A3=練習 C3=時間

當有空值的時候,系統依然會顯示,而且會出現已超過4萬多天的BUG,我該如何讓它不顯示呢?
--------------------------------------------------------------------------------------------------------------------------------
如果我要增加一個判斷,讓他在還有5分鐘的時候提醒,而且在開啟MSG視窗時可以出現一小段音效,不知道是否有辦法呢?

TOP

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
4#
發表於 2011-5-13 14:05 | 只看該作者
回復 3# vpower
那是多餘的,可刪掉.
  1. Private Sub CommandButton1_Click()
  2.     Dim TheDay#, Msg$, J1%, S$, H$
  3.     For J1 = 2 To Sheets("Sheet1").[C65536].End(xlUp).Row
  4.         If Range("C" & J1) <> "" And IsDate(Range("C" & J1)) Then
  5.             TheDay = Now - Range("C" & J1).Value: Msg = " 時間 已過"
  6.             If Range("C" & J1) >= Now Then TheDay = Range("C" & J1) - Now: Msg = " 時間 還有"
  7.             H = IIf(Abs(Int(TheDay)) > 0, Abs(Int(TheDay)) & "天", "") & Format(TheDay, "hh小時:mm分鐘:ss秒")
  8.             H = Replace(Replace(Replace(H, "00小時:", ""), "00分鐘:", ""), ":00秒", "")
  9.             S = IIf(S = "", "", S & vbNewLine) & "距離 " & Sheets("Sheet1").Range("A" & J1) & Msg & H
  10.         End If
  11.     Next
  12.     If S <> "" Then MsgBox S, , Format(Now, "dddddd ttttt")
  13. End Sub
複製代碼

TOP

vpower

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

     真是萬分感謝,我看了一下用原來那個天數的還是不會修改那個BUG,再麻煩您一下,感恩!
問題一:
  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 = ""
複製代碼
------------------------------------------------------------------------------------------------------------------

問題二:
然後如果是這個 小時 分鐘 秒數的
新增一個IF判斷, 然後我新增一個TextBox,依照我填入的數值X, 讓時間到前X分鐘提醒
填入的X和時間到前X分鐘的X是同一個.

TOP

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
6#
發表於 2011-5-14 09:45 | 只看該作者
回復 5# vpower
  1. Private Sub Workbook_Open()
  2.     For J1 = 2 To Sheets("Sheet1").[C65536].End(xlUp).Row
  3.         If Range("C" & J1) <> "" And IsDate(Range("C" & J1)) Then
  4.         ''''''''''''''''''''''''''''''''''''''''''''''''
  5.             I1 = DateDiff("D", Date, Range("C" & J1))
  6.             If I1 < 0 Then S1 = "的時間已經到了" & (-1) * (I1) & "天"
  7.             If S1 <> "" Then S2 = S2 & Sheets("Sheet1").Range("A" & J1) & S1 & vbNewLine
  8.             S1 = "": I1 = 0
  9.         '''''''''''''''''''''''''''''''''''''''''''
  10.         End If
  11.     Next
  12.     If S2 <> "" Then MsgBox S2
  13.     S2 = ""
  14. End Sub
複製代碼
  1. Sub 提醒()
  2.     Dim TheTime, TheTimeMsg$, Msg As Boolean
  3.     With Sheets("Sheet1")
  4.         For J1 = 2 To .[C65536].End(xlUp).Row
  5.             If Range("C" & J1) <> "" And IsDate(Range("C" & J1)) Then If Range("C" & J1) > Now Then Msg = True
  6.         Next
  7.         If Msg = False Then MsgBox "所有事件皆已過時!!", , "提醒": Exit Sub
  8.         Do
  9.             TheTime = Application.InputBox("輸入提醒分鐘", "提醒", , Msg)
  10.             If TheTime = "" Then Exit Sub
  11.             TheTimeMsg = TheTime
  12.         Loop Until TheTime >= 1 And TheTime <= 60
  13.         For J1 = 2 To .[C65536].End(xlUp).Row
  14.             If Range("C" & J1) <> "" And IsDate(Range("C" & J1)) Then
  15.                 If Range("C" & J1) - TimeValue("00:" & TheTime) > Now Then
  16.                 Msg = True
  17.                '二選一
  18.                 Application.OnTime Range("C" & J1) - TimeValue("00:" & TheTime), "Sheet1.CommandButton1_Click"
  19.                 'Sheet1.CommandButton1_Click  程式碼放在 Sheet1
  20.                  
  21.                 'Application.OnTime Range("C" & J1) - TimeValue("00:" & TheTime), "ThisWorkbook.Workbook_Open"
  22.                 'ThisWorkbook.Workbook_Open 程式碼放在 ThisWorkbook               
  23.                 End If
  24.             End If
  25.         Next
  26.     End With
  27. End Sub
複製代碼

TOP

vpower

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

GBKEE版主大大..積極又迅速的為我解決了我的難題..真的是太感謝了!!

我有個疑問,關於以下的設定,是否能夠和先前那個一樣,告知我距離A欄時間還剩下?分鐘呢? (在跳出MSG提醒視窗以前是否可以自動開啟C或D槽的指定檔案呢?這樣就可以有聲音提醒的效果了,沒有辦法也沒關係,感謝您)
  1. Sub 提醒()
  2.     Dim TheTime, TheTimeMsg$, Msg As Boolean
  3.     With Sheets("Sheet1")
  4.         For J1 = 2 To .[C65536].End(xlUp).Row
  5.             If Range("C" & J1) <> "" And IsDate(Range("C" & J1)) Then If Range("C" & J1) > Now Then Msg = True
  6.         Next
  7.         If Msg = False Then MsgBox "所有事件皆已過時!!", , "提醒": Exit Sub
  8.         Do
  9.             TheTime = Application.InputBox("輸入提醒分鐘", "提醒", , Msg)
  10.             If TheTime = "" Then Exit Sub
  11.             TheTimeMsg = TheTime
  12.         Loop Until TheTime >= 1 And TheTime <= 60
  13.         For J1 = 2 To .[C65536].End(xlUp).Row
  14.             If Range("C" & J1) <> "" And IsDate(Range("C" & J1)) Then
  15.                 If Range("C" & J1) - TimeValue("00:" & TheTime) > Now Then
  16.                 Msg = True
  17.                '二選一
  18.                 Application.OnTime Range("C" & J1) - TimeValue("00:" & TheTime), "Sheet1.CommandButton1_Click"
  19.                 'Sheet1.CommandButton1_Click  程式碼放在 Sheet1
  20.                  
  21.                 'Application.OnTime Range("C" & J1) - TimeValue("00:" & TheTime), "ThisWorkbook.Workbook_Open"
  22.                 'ThisWorkbook.Workbook_Open 程式碼放在 ThisWorkbook               
  23.                 End If
  24.             End If
  25.         Next
  26.     End With
  27. End Sub
複製代碼

TOP

vpower

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

回復 6# GBKEE


D欄我沒用到,DateDiff("D", Date, Range("C" & J1)),的D如何移除呢?
是這行 I1 = DateDiff("D", Date, Range("C" & J1))直接移除嗎?

------------------------------------------------------------------------
  1. Private Sub Workbook_Open()
  2.     For J1 = 2 To Sheets("Sheet1").[C65536].End(xlUp).Row
  3.         If Range("C" & J1) <> "" And IsDate(Range("C" & J1)) Then
  4.         ''''''''''''''''''''''''''''''''''''''''''''''''
  5.             I1 = DateDiff("D", Date, Range("C" & J1))
  6.             If I1 < 0 Then S1 = "的時間已經到了" & (-1) * (I1) & "天"
  7.             If S1 <> "" Then S2 = S2 & Sheets("Sheet1").Range("A" & J1) & S1 & vbNewLine
  8.             S1 = "": I1 = 0
  9.         '''''''''''''''''''''''''''''''''''''''''''
  10.         End If
  11.     Next
  12.     If S2 <> "" Then MsgBox S2
  13.     S2 = ""
  14. 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兔年全勤獎章
9#
發表於 2011-5-14 21:19 | 只看該作者
回復 8# vpower

    測試.rar (28.62 KB)

試試看看 開檔後有錯誤時請修改 下列程式的 播放音樂檔案
  1. Private Sub Workbook_Open()
  2.        '
  3.        '
  4.     With Sheet1.WindowsMediaPlayer1     '加入MediaPlayer播放音樂
  5.        .URL = "d:\愛的路上我和你.mp3"  '請修改音樂檔案
  6.         .Visible = False
  7.         .Controls.Stop
  8.     End With
  9.     事件提醒          '自動於時間到提醒
  10.     If S2 <> "" Then MsgBox S2
  11. End Sub
複製代碼

TOP

vpower

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

回復 9# GBKEE


找不到方法或資料成員,我想是不是要去下載關於增益集相關的東西.
顯示的字串 -->     .WindowsMediaPlayer1
  1. With Sheet1.WindowsMediaPlayer1     '加入MediaPlayer播放音樂
  2.        .URL = "D:\數羊歌.MP3"  '請修改音樂檔案
  3.         .Visible = False
  4.         .Controls.Stop
  5.     End With
  6.         For J1 = 2 To Sheets("Sheet1").[C65536].End(xlUp).Row
  7.         If Range("C" & J1) <> "" And IsDate(Range("C" & J1)) Then
  8.         ''''''''''''''''''''''''''''''''''''''''''''''''
  9.             I1 = DateDiff("D", Date, Range("C" & J1))
  10.             If I1 >= 0 And I1 <= 90 Then S1 = "在90天內過期"
  11.             If I1 <= 60 Then S1 = "在60天內過期"
  12.             If I1 <= 30 Then S1 = "在30天內過期"
  13.             If I1 < 0 Then S1 = "已過期" & (-1) * (I1) & "天"
  14.             If S1 <> "" Then S2 = S2 & Sheets("Sheet1").Range("A" & J1) & "-" & S1 & vbNewLine & vbNewLine
  15.             S1 = "": I1 = 0
  16.         '''''''''''''''''''''''''''''''''''''''''''
  17.         End If
  18.     Next
  19.     If S2 <> "" Then MsgBox S2
複製代碼
我自己做了一點功課,執行後,有出現提醒視窗,但是沒有音樂
插入Windows Media Player的做法如下:
1. 在 [檢視] 功能表上，指向 [工具列]，然後按一下 [控制工具箱]。
2. 在 [控制工具箱] 中，選[其他控制項] 按鈕。
3. 在控制項清單中，選[Windows Media Player]。
4. 用滑鼠游標拉出一個方塊以建立 Windows Media Player 控制項。
5. 在 [控制工具箱] 中，按一下 [屬性] 按鈕。
6. 在 [屬性] 視窗的 [FileName] 方塊中，輸入您想要播放的檔案路徑與名稱，然後按 ENTER。

TOP

        靜思自在 : 人要知福、惜福、再造福。
1234
返回列表 上一主題