Board logo

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

作者: 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/)