[發問] 寫一個天數累加的自訂函數

naraohya

大家好~~~在腦袋打結時，可以找到這個討論版，實在覺得太有幸了!!
欲麻煩各位先進們解救指點

想寫一個函數，用來計算天數的累加
功能大概是：
在B欄位有下拉選單，其值有PD, CL
若選單下拉選PD時，其C欄位會開始計算pending day (此位置也是欲放函數判斷的位置)
選單下拉選CL時，其C欄會停止累加，
但是下次選單再選PD時，C欄又需開始計算累加。

例如：
11/20 選PD時，C欄計值 1，過兩天11/22打開Excel，C欄的計值會自動成 3，並且也在這天將選單切換CL。
11/24再打開Excel，將選單改為PD，關閉檔案。
11/25打開，其C欄的計值會自動成 4。

目前這個功能，我分成很多地方來處理@@
煩請見附件 計算pending day.zip (10.22 KB)

下載次數: 9

2010-11-26 12:16

演示，以下為我的作法簡單說明：
1. 在C 欄有IF函數判斷：B 欄為PD時，值為1
2. 在D 欄也有IF函數判斷：C 欄值為1時，帶入今天的日期
3. 寫VBA在Excel關閉時，判斷D, C 欄皆為true時，就copy D 欄值至E欄
4. 一樣寫VBA在Excel關閉時，會更新E 欄的日期為今天的日期
5. 寫VBA在在Excel打開時，判斷今天日期與E 欄的日期不同，則做相減計算動作，帶入值C 欄去

我覺得我目前的作法搞得太複雜多餘......
所以一直很想簡化成函數來跑，不知道是否可行!? How??
再麻煩各位先進們指教一番，感謝！

GBKEE

回復 1# naraohya
用工作表的預設事件 將日期置於檔案試試

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2.     If Target(1).Cells = Range("B3") Then
   
3.         If Target = "PD" Then
   
4.             If [iv1] = "" Then
   
5.                 [c3].Resize(98) = 1
   
6.             Else
   
7.                 [c3].Resize(98) = [c3] + Date - [iv1]
   
8.             End If
   
9.             [iv1] = Date
   
10.         End If
    
11.     End If
    
12. End SubEnd Sub

複製代碼

naraohya

回復 2# GBKEE


先謝謝GBKEE大的回覆！您的寫法有夠簡明的，直是甘拜下風....
我不太了解「將日期置於檔案」，要放在哪個欄位上？
能否稍微詳細解惑說明一下，謝謝！

GBKEE

回復 3# naraohya
我放在 IV1 [工作表最右側] 或者你可以置於你用不到的地方 將日期紀錄下來

naraohya

回復 4# GBKEE


不好意思，GBKEE大，小的還是未試出來....
有確定將程式碼放在Worksheet_Change事件程序裡，
去切換B欄選單為PD時都未有動靜@@
1. 不太明白Resize(98)在此是指做了什麼動作?
2. 這段程式似乎只有在同一列，在B3, C3才可運行!?
但我需要若B欄有設定PD時，隔壁的C欄就會開始計算累加......
再麻煩提點，感謝！

GBKEE

回復 5# naraohya
1. 不太明白Resize(98)在此是指做了什麼動作?
你的附檔 是指 Range("B3") 有 "PD" 字串時 -> [c3].Resize(98)=計算日數  
[c3].Resize(98)-> 含c3擴充98列 =c3:c100的範圍
2. 這段程式似乎只有在同一列，在B3, C3才可運行!?
請附檔看看

Hsieh

回復 1# naraohya


不知道有沒有理解錯誤
直接讓D欄記住第一次B欄選PD時的日期(這用CHANGE事件來輸入C，D欄的值)
Sheet3模組

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2. If Target.Count > 1 Then Exit Sub
   
3. If Intersect(Target, [B3:B100]) Is Nothing Or Target = "" Then Exit Sub
   
4. Application.EnableEvents = False
   
5. If Target.Offset(, 1) = "" Then Target.Offset(, 1).Resize(, 2) = Array(IIf(Target = "PD", 1, ""), IIf(Target = "PD", Date, ""))
   
6. Application.EnableEvents = True
   
7. End Sub

複製代碼

每次開檔時計算D欄日期到當日的天數並更改D欄為當日日期

1. Private Sub Workbook_Open()
   
2. Dim A As Range
   
3. With Sheet3
   
4. Application.EnableEvents = False
   
5. For Each A In .[B3:B100]
   
6.    If A = "PD" And IsDate(A.Offset(, 2)) Then _
   
7.    A.Offset(, 1) = _
   
8.    DateDiff("d", A.Offset(, 2), Date) + A.Offset(, 1): A.Value = "CL": A.Offset(, 2) = Date
   
9. Next
   
10. Application.EnableEvents = True
    
11. End With
    
12. End Sub

複製代碼

計算pending day.zip (11.84 KB)

下載次數: 5

2010-11-27 18:32

naraohya

回復 6# GBKEE


謝謝GBKEE大不厭其煩的回覆，檔案有試出來
我放錯到工作簿事件去了.....(揍飛)
不過試出後，跟我要的運作是不太一樣，以下：
1. B欄一選PD時, 其C欄的pending day並沒有先累計值1，而是0
2. 呈上，例：在B3欄選值PD時，期望是僅旁邊的C3欄有值，而非整排的C欄都有值。
3. 隔天打開Excel，其pending day未自動更新其天數，是再重新點選B欄選擇PD，pending day才更新。

總之，非常謝謝，提供了我另一種VBA的學習寫法！

naraohya

回復 7# Hsieh


謝謝Hsieh大的回覆，我先試了作法，明天有時間再來好好消化程式碼 XD (我對 offset的用法老是感到頭昏@@)
有發現一個小錯誤：
第二篇程式碼第8列 :A.Value="CL" 好像應該設"PD"

另外，只有該列B欄值為PD，其D欄才更新日期，但B欄值為CL的卻未更新，
這樣對於之後B欄的CL又改為PD時，其pending day算出值在邏輯上是不對的。

兩位大大的寫法，都有給我新啟發，期盼我可以碰撞出滿意的作法!! 有的話會再來分享唷~~希望!!