續問三-Excel VBA / Formula把需要的加總

這裡做了三個 vba 程序：

1，用 vba 產生按鈕
2，用 vba 刪除按鈕
3，主程序，篩選數據，並輸出。

請將所有程序放入主工作表的 "私家辦公室" 。
看圖：

圖片參考：http://w2.hkmalls.com/rc/126b/capture.jpg


請將主工作表定名為 "MAIN" ，否則將程序裡面的 "MAIN" 改為實際的主表名。


Private Sub my_output_bttn_Click()

'按鈕被按就會呼叫此程式。

Dim arr(1 To 10000, 1 To 4) ' 主陣列，儲存資料
Dim arr2(1 To 10000, 1 To 3) ' 副陣列，儲存從主陣列篩選出來的資料
Dim R%, endRow%, i%, atY%, aCount%

' ///////////////////////////////////////////////
' 從主工作表找出有效資料，存入陣列 arr

Sheets("MAIN").Select
endRow = Cells(Rows.Count, 1).End(xlUp).Row

For R = 2 To endRow
modl = Trim(Cells(R, 1).Value)
quan = Trim(Cells(R, 2).Value)
tout = Trim(Cells(R, 4).Value)
grup = Trim(Cells(R, 5).Value)

If InStr("g: 1101RI1 1501CS1 1501PA7", UCase(grup)) < 2 Then GoTo 222
'切勿刪掉 "g: "

atY = 0
For i = 1 To aCount
If arr(i, 2) = modl Then atY = i
Next

If atY = 0 Then
aCount = aCount + 1
atY = aCount
arr(atY, 1) = aCount
arr(atY, 2) = modl
End If

If LCase(tout) = "today out" Then
arr(atY, 3) = arr(atY, 3) + Evaluate(quan)
ElseIf UCase(tout) = "NO MOVE" Then
arr(atY, 4) = arr(atY, 4) + Evaluate(quan)
Else
Cells(R, 4).Select
MsgBox "Error found!" & Chr(13) & Chr(13) & "Neither [today out] nor [NO MOVE]" & Chr(13) & Chr(13) & "program ceased"
Exit Sub
End If

222:
Next

' ///////////////////////////////////////////////
' 從陣列 arr 篩選 "today out" 載入陣列 arr2

Erase arr2 ' 清空陣列 arr2
atY = 0

For i = 1 To aCount
If arr(i, 3) > 0 Then ' 陣列arr 列i元素3(today out) 有數就抄入 arr2
atY = atY + 1
arr2(atY, 1) = atY
arr2(atY, 2) = arr(i, 2)
arr2(atY, 3) = arr(i, 3)
End If
Next

Sheets("Sheet1").[A5].Resize(10000, 3).ClearContents '清空這範圍舊資料
Sheets("Sheet1").[A5].Resize(atY, 3) = arr2 ' 寫入陣列 arr2

Sheets("Sheet3").[A5].Resize(10000, 3).ClearContents
Sheets("Sheet3").[A5].Resize(atY, 3) = arr2

' ///////////////////////////////////////////////
' 從陣列 arr 篩選 "NO MOVE" 載入陣列 arr2

( 中略若干行 )

End Sub


Yahoo 字數限制，不能盡貼。
請到此處抄回



2009-09-20 08:26:09 補充：
程式寫的很簡單(所以很長)，方便你將來自行修改，增減。

我模擬5000列資料，執行在0.5妙以下，工作正常。

你測試後發現問題請來信修正。

一答：
這四張SHEET我是COPY AND PASTE 制造出來的，當然是一樣啦^_^
我只是解釋我需要的做法及條件，sheet內容是假的..令你誤會了!
真不好意思 ^_^

二答：
有按鈕當然好，但如果我套用在我的真實版本裡，需否再要修改呢?

2009-09-16 21:36:21 補充：
三答：
在我心目中你的確是高手，請勿見怪我這樣稱呼你..不過我也會尊重你的。下次不會再點名，不過你一定要搶答喎。
點名是因為第一條問題是你為我解決了，我覺得你比較容易理解我的進階問題，所以有此決定再呼換你......^_^

四答：
為我解決了難題，得分是應份的，你叫我不給你分，我還覺得不好意思呢:D (這點你真的難為了我呢 ^_^)
唔怕話你知呀，當我問第一條問題時，我是想給四十分的，不過系統最多只能出二十分...>_<....(是真的..!!)

2009-09-17 21:05:02 補充：
補充：

D 欄不是 "today out" , 便會是"NO MOVE" ，不會空的。
即是D爛只會有以上兩個情況的。

以下說法無錯：
見到 "today out" 就加總，見到 "NO MOVE" 就加另一個總，然後輸出
today out ＞sheet1 , sheet3
NO MOVE ＞ sheet2, sheet4
(但都要合符埋下面那幾個1101RI1 1101RI2....等等我註明的條件)

2009-09-17 21:05:17 補充：
但是：還有可能有些情況是
當 "today out" 及"NO MOVE" 情況都符合，即是要晒。
(再配合埋下面的1101RI1 1101RI2....等等要求的)
然後輸出到sheet5 (不能有重覆model顯示的)

如此類推：
可能我會有十張sheet都是從來源數據裡，
把合適條件的型號及數量，加總及顯示到另一張sheet

2009-09-17 21:05:33 補充：
情況就有以上提及的三個
(i) "today out"
(ii) "NO MOVE"
(iii) "today out" 及"NO MOVE"

(加埋條件1101RI1 1101RI2.....等等的要求)

2009-09-17 21:05:45 補充：
其實可唔可以咁講呢?

就是在程式裡有齊晒呢三種條件的程式，

到將來當我有需要更改要求的條件時，
也可以自行修改要求的條件，
又當我想把結果貼到另一頁時，
又可以自行變更SHEET NAME ，計算結果便貼到我所要求的目的地。

2009-09-17 21:05:58 補充：
如果程式內容分得很明確，給我一看便了解..那部份是執行
SHEET 1 的結果的
那部份是執行SHEET 2的結果的..
如此類推地...
(便能達到我所希望程式能我給我加加減減了)
即是當我第時有另一個來源資料時，
我也能把這個程式套用在另一個來源資料裡去計算結果之後把結果貼到我指定的SHEET裡。

程式長一點都不是問題
最重要是活用

2009-09-20 14:48:53 補充：
好呀，
待我測試後遇到問題再找你...THANK A LOT ^_^