麻辣家族討論版版 - Powered by Discuz! Board

標題: [發問] 依各部門加總後顯示扣除減少後之數據... [打印本頁]

作者: cypd 時間: 2022-11-20 21:19 標題: 依各部門加總後顯示扣除減少後之數據...

說明:1.希望結果為 H、I、J、K 各欄之加總(合計)…條件準則需依照每月條件有無增加/減少試算加總。
2.合計部分需扣除各部門所列條件減少之數據...H2、I2、J2、K2 各欄之加總(合計)需扣除各部門所列條件減少之數據。
3.U欄原價依各部門加總後顯示扣除減少後之數據。
4.V、W欄依各部門加總後顯示扣除減少後之數據。
5.X欄金額依各部門加總後顯示扣除減少後之數據。

希望結果 H2、I2、J2、K2、U5~U8、V5~V8、W5~W8、X5~X8 之加總(合計)需扣除各部門所列條件減少之數據含有公式。

[attach]35496[/attach]

[attach]35497[/attach]

作者: 准提部林 時間: 2022-11-21 18:40

看不懂//先做個
[attach]35500[/attach]

也可用sumifs

作者: cypd 時間: 2022-11-21 21:43

回復 2# 准提部林

感謝准提部林之指導
另附上說明

[attach]35501[/attach]
T21財務部為例
1.原價計算=470000+266000+1355000+新增1390000=3481000
2.本年=40192+175840+46334=262366
3.累計=240500+266000+404432+46334=957266
4.金額=229500+950568+1343666=2523734
5.原價增加=1390000
6.原價減少=776922+461000=1237922(2筆原價減少…H欄)
7.

作者: cypd 時間: 2022-11-23 19:05

回復 3# cypd

感謝准提部林之指導
看不懂//
(Xl0000208.rar...針對公式內若是各部門有增加時加總試算無法產生所需結果)
另補附上說明參考...能修正所需公式

作者: Andy2483 時間: 2022-11-24 15:27

回復 3# cypd

謝謝前輩發表此主題與範例
後學藉此帖練習字典中字典,請前輩試試看!
請前輩們指正並指導!謝謝
執行前:
[attach]35520[/attach]

執行結果:
[attach]35521[/attach]

Option Explicit
Sub test()
Dim Brr, Crr, i&, x, Y, K&
Dim 部門$, 原價&, 本年&, 累計&, 金額&, 增減$
Set Y = CreateObject("Scripting.Dictionary")
Brr = Range([含公式!P1], [含公式!A65536].End(3))
For i = 5 To UBound(Brr)
部門 = Brr(i, 1)
原價 = Brr(i, 8)
本年 = Brr(i, 9)
累計 = Brr(i, 10)
金額 = Brr(i, 11)
增減 = Brr(i, 16)
If Y.Exists(部門) = False Then
   Set Y(部門) = CreateObject("Scripting.Dictionary")
End If
If 增減 = "" Or 增減 = "增加" Then
   Y(部門)(1) = Y(部門)(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)
For Each x In Y.KEYS
K = K + 1
Crr(K, 1) = x
For i = 2 To 11
   Crr(K, i) = Y(x)(i - 1)
   Crr(UBound(Crr), i) = Crr(UBound(Crr), i) + Y(x)(i - 1)
Next
Next
Crr(UBound(Crr), 1) = "合計"
[T5].Resize(UBound(Crr), 11) = Crr
Set Y = Nothing
Set Brr = Nothing
Set Crr = Nothing
End Sub

作者: cypd 時間: 2022-11-24 17:15

回復 5# Andy2483

太感謝您 Andy2483 熱心的回覆：
經實測可符合所需結果喔 ^^

需求1：在發問題示中是否能再將該程式碼含 H2、I2、J2、K2 各欄之合計含有U9、V9、W9、X9合計數據。

需求2：該檔案(含公式1、含公式2、含公式3…)計有12個月份的工作表
請問該程式碼該如何運用在這 12 個工作表不會互相干擾執行運算??

作者: 准提部林 時間: 2022-11-24 19:09

回復 4# cypd

[attach]35522[/attach]

作者: Andy2483 時間: 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

這些程式碼要放在工作表模組裡才能用

作者: cypd 時間: 2022-11-25 14:02

回復 7# 准提部林

感謝准提部林  之回覆
SUMPRODUCT(($A$5:$A$64=$T5)*($P$5:$P$64<>"減少"),H$5:H$64)
原來差異之處在於指定  <>"減少"
現已達成合計試算感恩  ^^

作者: cypd 時間: 2022-11-25 14:07

回復 8# Andy2483

感謝您 Andy2483 熱心的回覆：
看了工程浩大的程式碼太勞煩您了! 感恩 ^^
執行過程中出現以下偵錯

[attach]35523[/attach]

請問該如何修正...

作者: Andy2483 時間: 2022-11-25 14:55

回復 10# cypd

謝謝前輩回復
1.工程不浩大! 只是多加了心得註解做學習,可以加深印象!且更明確自己的邏輯!
2.這些程式碼要放在工作表模組裡才能用:
[attach]35524[/attach]
3.到 [A2] 合計那個儲存格用左鍵快按兩下才會執行

作者: cypd 時間: 2022-11-25 22:46

回復 11# Andy2483

非常感謝您 Andy2483 熱心撥空思考回覆：
經實測該程式碼會各自產生一個獨立檔案(活頁簿1、2...)

需求1：已符合。

[attach]35527[/attach]

需求2：該檔案(含公式1、含公式2、含公式3…)計有12個月份的工作表
請問該程式碼該如何運用在這 12 個工作表不會互相干擾執行運算??
PS：該1個檔案內有12個工作表
目前是 11 月份
所以會使用含公式 11 之工作表作統計
下個月是12月份...以此類推
該程式碼會各自產生一個獨立檔案(活頁簿1、2...)
該如何修正如上所述…

[attach]35528[/attach]

作者: Andy2483 時間: 2022-11-26 06:28

回復 12# cypd
謝謝前輩再回覆
1.新產生的活頁簿裡也有相同的程式碼,若再此新活頁簿的［A2]合計格在左鍵快按兩下,又會再生成一分新活頁簿
1.1.新活頁簿不會影響別的檔案
1.2.反之如果被別的檔案影響！excel 會做提示
2.學VBA很有趣,比公式簡單多了,前輩運用看看
3.後學學了十多年了,進步很慢！但樂此不疲！
4.請前輩常上論壇一起學習,論壇的前輩們超厲害的！

作者: cypd 時間: 2022-11-27 01:39

回復 13# Andy2483

非常感謝您 Andy2483 熱心撥空不吝指導回覆：
深感佩服能細心的回覆與詳細解說...獲益良多
複雜的程式碼執行迅速獲解...謝謝 ^^

作者: cypd 時間: 2022-11-27 23:50

回復 13# Andy2483

想再次請問  Andy2483  以下問題
執行  excel 檔案時檢視--巨集--執行
發生以下問題...不知該如何修復??(檔案在其他電腦執行是正常的)

問題簽章:
  問題事件名稱: APPCRASH
  應用程式名稱: EXCEL.EXE
  應用程式版本: 15.0.5501.1000
  應用程式時間戳記: 6345972d
  錯誤模組名稱: EXCEL.EXE
  錯誤模組版本: 15.0.5501.1000
  錯誤模組時間戳記: 6345972d
  例外狀況代碼: c0000005
  例外狀況位移: 00000000007d2f06
  作業系統版本: 6.1.7601.2.1.0.256.48
  地區設定識別碼: 1028

[attach]35529[/attach]

[attach]35530[/attach]

[attach]35531[/attach]

只有 excel 檔案在檢視--巨集--執行時出現上述狀況(office 2013 已重新安裝還是出現如上問題)

作者: Andy2483 時間: 2022-11-28 08:24

回復 15# cypd

謝謝前輩再回覆
後學沒有處裡過這種問題的經驗

https://answers.microsoft.com/zh-hant/windows/forum/all/appcrash/c0f2bb7b-e037-4154-8680-dfdc2e535235
以上網址微軟社群有類似的方案可以參考看看

作者: cypd 時間: 2022-12-1 16:12

回復 7# 准提部林

請問版主...准提部林

說明:1.問題所示為以營業部為例
2.本月新增一筆原價為369300(增加部分為逐月1~12累計統計)
3.營業部計4筆合計為1366975
4.營業部4筆合計為1366975(其中一筆36300為本月新增加數據要有紀錄)、因此4筆另有他用希望結果以輸入一筆1366975視為減少全部核銷該4筆紀錄(所以營業部原價、本年、累計、金額等數據產生結果希望為 0)。
5.無第4點狀況未全部核銷...其他部門數據計算方式不變喔!
6.該如何修正公式?(P5、P6、P7點選減少)

[attach]35547[/attach]

[attach]35548[/attach]

作者: cypd 時間: 2022-12-10 23:23

回復 17# cypd

承上問題補充說明:
1.問題所示為以營業部為例
2.本月新增一筆原價為369300(增加部分為逐月1~12累計統計)
3.營業部計4筆合計為1366975(369300、492400、135975、369300)
4.營業部4筆合計為1366975(其中一筆369300為本月新增加數據要有紀錄)、因此4筆另有他用希望結果以輸入一筆1366975視為減少全部核銷該4筆紀錄(所以營業部原價、本年、累計、金額等數據產生結果希望為 0)。
5.U5...之公式 SUMPRODUCT(($A$5:$A$64=$T5)*($P$5:$P$64<>"減少"),H$5:H$64)請問該如何修正?(營業部原價U20、本年V20、累計W20、金額X20等數據產生結果希望為 0。

[attach]35582[/attach]

[attach]35583[/attach]

作者: cypd 時間: 2022-12-18 16:52

回復 cypd

承上問題補充說明:
1.問題所示為以營業部為例
2.本月新增一筆原價為369300(增加部分為逐月 ...
cypd 發表於 2022-12-10 23:23

尋求上述問題 U5...之公式 SUMPRODUCT(($A$5:$A$64=$T5)*($P$5:$P$64<>"減少"),H$5:H$64)請問該如何修正?或是有其他方式...

作者: 准提部林 時間: 2022-12-20 16:13

回復 19# cypd

後面的減少可抵前面金額, 前面的減少無法抵後面的金額,
這用公式無法判斷, 哪個減少去抵哪個金額~~
資料太少__用VBA可能也找不到邏輯~~

作者: cypd 時間: 2022-12-21 15:59

回復 20# 准提部林

非常感謝准提部林之回覆
所提問題會再詳細研討

歡迎光臨麻辣家族討論版版 (http://forum.twbts.com/)