返回列表 上一主題 發帖

[發問] 依各部門加總後顯示扣除減少後之數據...

[發問] 依各部門加總後顯示扣除減少後之數據...

說明: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        之加總(合計)需扣除各部門所列條件減少之數據含有公式。
       
  
1120.jpg
2022-11-20 21:19


1120.rar (18.11 KB)

看不懂//先做個
Xl0000208.rar (10.26 KB)

也可用sumifs

TOP

回復 2# 准提部林

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

1121.jpg
7 天前 21:41

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.

Xl0000208+.rar (10.98 KB)

TOP

回復 3# cypd

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

TOP

回復 3# cypd


    謝謝前輩發表此主題與範例
後學藉此帖練習字典中字典,請前輩試試看!
請前輩們指正並指導!謝謝
執行前:
2022-11-24_150920.JPG
4 天前 15:14


執行結果:
2022-11-24_150940.JPG
4 天前 15:14


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

TOP

回復 5# Andy2483

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

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

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

TOP

回復 4# cypd

Xl0000208+.rar (10.97 KB)

TOP

本帖最後由 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

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

TOP

回復 7# 准提部林

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

TOP

回復 8# Andy2483

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

sshot-1.jpg
3 天前 14:06


請問該如何修正...

TOP

        靜思自在 : 人的心地是一畦田,土地沒有播下好種子,也長不出好的果實。 -
返回列表 上一主題