- 帖子
- 1447
- 主題
- 40
- 精華
- 0
- 積分
- 1471
- 點名
- 0
- 作業系統
- Windows 7
- 軟體版本
- Excel 2010 & 2016
- 閱讀權限
- 50
- 性別
- 男
- 來自
- 台灣
- 註冊時間
- 2020-7-15
- 最後登錄
- 2025-5-5
|
8#
發表於 2022-11-25 10:28
| 只看該作者
本帖最後由 Andy2483 於 2022-11-25 10:36 編輯
回復 6# cypd
謝謝前輩回復
請使用 准提部林前輩的方案!後學的練習當參考就好
因為VBA與公式混用需要複雜點的想法才比較安全!
不然會有用錯報表的顧慮
請前輩們指正並指導!謝謝
以下是後學的學習心得註解:
Option Explicit
Dim WNa
'↑宣告模組變數
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'↑雙擊觸發
With Target
'↑以下關於觸發
If .Address = "$A$2" Then
'↑如果觸發的儲存格位址是 [A2]
ActiveSheet.Copy
'↑整個現用工作表複製到新的活頁簿
Set WNa = ActiveWorkbook.ActiveSheet
'↑令WNa 是這新活頁簿的現用工作表(以下稱:新表)
MsgBox "結果放在新增活頁簿: " & ActiveWorkbook.Name
'↑跳出提示窗: 結果放在新增活頁簿: 活頁簿名稱
Call test
'↑執行副程式 test()
Cancel = True
'↑取消 原本雙擊儲存格可在儲存格內編輯文字 的功能執行
End If
End With
End Sub
Private Sub test()
Dim Brr, Crr, i&, x, Y, K&
Dim 部門$, 原價&, 本年&, 累計&, 金額&, 增減$
'↑宣告變數
Set Y = CreateObject("Scripting.Dictionary")
'↑令Y 是字典
Brr = WNa.Range(WNa.[P1], WNa.[A65536].End(3))
'↑令Brr是陣列! 倒入新表的[P1]到 新表A欄最後一個有內容的儲存格 之間方正區域儲存格的值
For i = 5 To UBound(Brr)
'↑設順迴圈! 從5 到Brr陣列縱向最後列號
部門 = Brr(i, 1)
'↑令部門$ 這變數 是Brr陣列的第一欄迴圈列位置字串
原價 = Brr(i, 8)
'↑令原價& 這變數 是Brr陣列的第八欄迴圈列位置數字
本年 = Brr(i, 9)
'↑令本年& 這變數 是Brr陣列的第九欄迴圈列位置數字
累計 = Brr(i, 10)
'↑令累計& 這變數 是Brr陣列的第十欄迴圈列位置數字
金額 = Brr(i, 11)
'↑令金額& 這變數 是Brr陣列的第十一欄迴圈列位置數字
增減 = Brr(i, 16)
'↑令增減$ 這變數 是Brr陣列的第十六欄迴圈列位置字串
If Y.Exists(部門) = False Then
'↑如果Y字典裡沒有 迴圈變數部門的key(鍵) ??
Set Y(部門) = CreateObject("Scripting.Dictionary")
'↑令 迴圈變數部門的key 是字典!
'以i是5為例:部門是營業部,"營業部"令他生成一個物件字典:
'也就是Y字典中有一個 "營業部"的 key,
'同時又存在著一部字典名叫 "營業部"
'所以這行程式碼共做了兩件事
End If
If 增減 = "" Or 增減 = "增加" Then
'↑如果增減$ 這字串變數 是空白 或 這字串變數 是"增加"字串??
Y(部門)(1) = Y(部門)(1) + 原價
'↑當i=5
'令Y字典中key是 營業部的字典裡的key是1的item,累加 原價& 這變數的數字
'所以這行程式碼也做了兩件事:
'1.因為Y字典中營業部的字典裡原本沒有 1的key,
'當我們令 Y(部門)(1) = 這動作就已經自動生成 Y字典中營業部的字典裡 1的key
'2.而 = Y(部門)(1) + 原價& 就是 Y字典中營業部的字典裡 key是1 的item
'為什麼要 在Y字典中營業部的字典裡設一個key是1,Item是原價&累加值??
'因為key 1是要指定後面程序要放在Crr陣列的位置 如註解標記 @1
Y(部門)(2) = Y(部門)(2) + 本年
'↑這行程式碼類推
Y(部門)(3) = Y(部門)(3) + 累計
'↑這行程式碼類推
Y(部門)(4) = Y(部門)(4) + 金額
'↑這行程式碼類推
If 增減 = "增加" Then
Y(部門)(5) = Y(部門)(5) + 原價
'↑這行程式碼類推!只是多加了一個判斷:如果 增減$這字串變數是 "增加"
End If
ElseIf 增減 = "減少" Then
Y(部門)(6) = Y(部門)(6) + 原價
Y(部門)(7) = Y(部門)(7) + 累計
Y(部門)(9) = Y(部門)(7)
Y(部門)(10) = Y(部門)(10) + 金額
'↑這行程式碼類推!只是多加了一個判斷:否則如果 增減$這字串變數是 "減少"
End If
Next
ReDim Crr(1 To Y.Count + 1, 1 To 11)
'↑宣告Crr陣列的範圍:縱向是從1到Y字典裡共有幾個部門的key的數量列再加1,
'再加1 是為了要放總合計
'橫向是從1 到11 ,因為結果位置有11欄 T:AD
For Each x In Y.KEYS
'↑設外順迴圈!令x 是Y字典當中的一個key!從 營業部 到 研發部
K = K + 1
'↑令K 累加1,前面是宣告K 是長整數,所以從0開始累加1
Crr(K, 1) = x
'↑迴圈一開始令Crr陣列第一列第一欄位置是 "營業部" 字串
'後續迴圈....
For i = 2 To 11
'↑設內順迴圈從2 到11
Crr(K, i) = Y(x)(i - 1) '@1
'↑令Crr陣列相對的位置裝入 查Y字典中的字典的item
Crr(UBound(Crr), i) = Crr(UBound(Crr), i) + Y(x)(i - 1)
'↑令Crr陣列的最後列累加每一項 查Y字典中的字典的item
Next
Next
Crr(UBound(Crr), 1) = "合計"
'↑令Crr陣列的最左下角那位置是 "合計" 字串
WNa.[T5].Resize(UBound(Crr), 11) = Crr
'↑將Crr陣列值倒入新表,從新表[T5]向下擴展 Crr陣列縱向列號數,向右擴展11欄,
'倒入這範圍裡
WNa.[H2] = Crr(UBound(Crr), 2)
'↑令新表[H2]值是 Crr陣列最下面列位,右第二個數字
WNa.[I2] = Crr(UBound(Crr), 3)
'↑令新表[I2]值是 Crr陣列最下面列位,右第三個數字
WNa.[J2] = Crr(UBound(Crr), 4)
'↑令新表[I2]值是 Crr陣列最下面列位,右第四個數字
WNa.[K2] = Crr(UBound(Crr), 5)
'↑令新表[K2]值是 Crr陣列最下面列位,右第五個數字
Set Y = Nothing
Set Brr = Nothing
Set Crr = Nothing
End Sub
這些程式碼要放在工作表模組裡才能用 |
|
發表於 2022-11-21 18:40
| 
