Board logo

標題: 請教 公式_跳欄並且符合條件才加總 [打印本頁]

作者: Andy2483    時間: 2020-8-24 10:51     標題: 請教 公式_跳欄並且符合條件才加總

各位前輩好
請教 公式_跳欄並且符合條件才加總
1.加總格AC13
2.從AG13開始跳4欄相加至最後欄位
2.1.當欄的第10列儲存格不以"前置" 開頭
2.2.以迴圈執行的迴圈範例如下
謝謝指導

Sub 迴圈範例()
Dim i&
[AC13] = 0
For i = 33 To 256 Step 4
   If Cells(10, i) Like "前置*" = False Then
      [AC13] = [AC13] + Cells(13, i)
   End If
Next
End Sub
'AC13 =SUMPRODUCT((MOD(COLUMN(AG:IV),4)=1)*AG13:IV13)
作者: 准提部林    時間: 2020-8-24 11:13

發帖如果是求助的,
最好上傳範例測試檔, 是基本的,
也可準確根據資料結構去了解問題,
大家不想再花時間為了解題去建測試資料!!!
作者: Andy2483    時間: 2020-8-24 12:43

回復 2# 准提部林


    謝謝前輩提醒
上傳範例
作者: Andy2483    時間: 2020-8-24 12:49

回復 2# 准提部林


    上傳失敗!
疑似限制上傳 回家再處裡
謝謝指導
作者: Andy2483    時間: 2020-8-24 13:36

手機試上傳範例檔
作者: Andy2483    時間: 2020-8-24 13:40

回復 2# 准提部林
前輩好
手機完成範例上傳
作者: 准提部林    時間: 2020-8-24 14:53

若只比對前兩字, 也可:
If Left(Cells(10, i), 2) <> "前置" Then

每3欄為一個群組, STEP  3 才對吧!
作者: Andy2483    時間: 2020-8-24 15:37

回復 7# 准提部林

1. If Left(Cells(10, i), 2) <> "前置" Then
   是! 但是不知如何加到下列公式裡,或其他方法
AC13 =SUMPRODUCT((MOD(COLUMN(AG:IV),4)=1)*AG13:IV13)

2.每3欄為一個群組, STEP  3 才對吧!
   對不起!  有一欄是備用欄 隱藏起來了
作者: 准提部林    時間: 2020-8-24 15:38

回復 8# Andy2483

有看到隱藏欄,
Sub TEST()
Dim Arr, Brr, R&, C&, i&, j&, k%
R = Cells(Rows.Count, "d").End(xlUp).Row '最後一行
C = Cells(12, Columns.Count).End(xlToLeft).Column '最後一欄
Arr = Range(Cells(R, "AG"), Cells(10, C)) '定義資料範圍 AG10:???
ReDim Brr(1 To UBound(Arr) - 3, 1 To 3) '設空陣列
For i = 4 To UBound(Arr)
For j = 1 To UBound(Arr, 2) Step 4
    If Left(Arr(1, j), 2) = "前置" Then GoTo j01
    For k = 1 To 3
        Brr(i - 3, k) = Brr(i - 3, k) + Arr(i, j + k - 1)
    Next k
j01: Next j
Next i
[AC13].Resize(UBound(Brr), 3) = Brr
End Sub


'===================================
作者: Andy2483    時間: 2020-8-24 15:54

回復 9# 准提部林


    謝謝前輩指導
1.這陣列方法只懂皮毛,也需要學習! 我會藉這帖學會他
2.原本想法是用VBA下公式在AC欄 下刷得到加總值
2.1.定義資料範圍 AG10:???  :是認為下公式加到最後IV欄 空格也不影響,而且欄位增減機率很高
2.2.用下公式的方法也不簡單
謝謝指導
作者: Andy2483    時間: 2020-8-24 16:35

回復 9# 准提部林


Arr = Range(Cells(R, "AG"), Cells(10, C))
這行是設定資料範圍! 不懂
Cells(R, "AG") 是10
Cells(10, C) 是0
Arr = Range(10, 0)
為什麼??
請再指導
作者: 准提部林    時間: 2020-8-24 17:13

回復 11# Andy2483

Dim Arr, Brr, R&, C&, i&, j&, k%, xArea As Range
R = Cells(Rows.Count, "d").End(xlUp).Row
MsgBox R & "(D欄最後一行)"
C = Cells(12, Columns.Count).End(xlToLeft).Column
MsgBox C & "(最右一欄)--位址:" & Cells(12, C).Address
Set xArea = Range(Cells(R, "AG"), Cells(10, C))
MsgBox "資料範圍:" & xArea.Address
'Arr = Range(Cells(R, "AG"), Cells(
作者: 准提部林    時間: 2020-8-24 17:16

本帖最後由 准提部林 於 2020-8-24 18:44 編輯

不然用公式??
AC13:
=SUMIF($AG$10:$GW$10,"*",AG13:GW13)-SUMIF($AG$10:$GW$10,"前置*",AG13:GW13)

=SUMPRODUCT(--(LEFT($AG$10:$GW$10&"前置",2)<>"前置"),AG13:GW13)

右拉3格, 下拉

計算位址右拉時, 是移位的, 自行參酌~~
作者: 准提部林    時間: 2020-8-24 17:19

VBA中的陣列用法, 要早點了解,
最好也理解字典用法,
字典+陣列, 可處理很多種資料的處理及統計運算需求,
否則隨著資料越多, 就越不好處理~~
作者: 准提部林    時間: 2020-8-24 19:03

Sub TEST2()
Dim Arr, Brr, R&, C&, i&, j&, k%
R = Cells(Rows.Count, "d").End(xlUp).Row
C = Cells(12, Columns.Count).End(xlToLeft).Column
Arr = Range([A1], Cells(R, C))
ReDim Brr(1 To UBound(Arr) - 12, 1 To 3)
For i = 13 To UBound(Arr)
For j = [AG1].Column To UBound(Arr, 2) Step 4
    If Left(Arr(10, j), 2) = "前置" Then GoTo j01
    For k = 1 To 3
        Brr(i - 12, k) = Brr(i - 12, k) + Arr(i, j + k - 1)
    Next k
j01: Next j
Next i
[AC13].Resize(UBound(Brr), 3) = Brr
End Sub

改成這樣是否較易理解?
Cells(R, C) 就是資料區最右/最下一格
Range([A1], Cells(R, C)) 從a1向下/向右的區域



==================================
作者: Andy2483    時間: 2020-8-24 20:33

回復 15# 准提部林


還沒有用PC測試
以結果反推裡面程碼的意義 大概了解
1.兩個容器 Arr裝原來的資料 Brr裝回圈的結果
UBound(Arr)是指Arr的縱向陣列數
UBound(Arr, 2)是指Arr的橫向陣列數
2. Arr = Range(Cells(R, "AG"), Cells(10, C))是反對角定義範圍嗎?
沒看過 就慌了
謝謝指導
明早出差 撥空繼續研習 還有公式版呢 真期待
作者: Andy2483    時間: 2020-8-25 20:17

回復 9# 准提部林


前輩的迴圈比較難 ,換個角度比較看得懂
可能跟心境有關吧
您無私的把懂的傳授給我們 成就我們
Andy只懂得接受前輩的指導 增長自己
謝謝
For k = 1 To 3
For i = 4 To UBound(Arr)
For j = 1 To UBound(Arr, 2) Step 4
    If Left(Arr(1, j), 2) = "前置" Then GoTo j01
        Brr(i - 3, k) = Brr(i - 3, k) + Arr(i, j + k - 1)
j01: Next j
Next i
Next k
作者: Andy2483    時間: 2020-8-25 20:21

回復 9# 准提部林


    對不起 !
忘了問迴圈方式不同執行效率有差別嗎?
作者: Andy2483    時間: 2020-8-25 22:33

回復 18# Andy2483


    還沒有測試 但應該有差
因為少判斷 前置 很多次
就直接跳到 j01
撥空再測試 學習
作者: Andy2483    時間: 2020-8-26 07:46

回復 14# 准提部林


    搞不懂 哪裡錯
分項比總和大
作者: 准提部林    時間: 2020-8-26 10:25

回復 20# Andy2483


1) 每次發帖都只提供簡化版, 當然得不到正確解答, 除非你真的已可自己修改程式或公式
2) 以這版本來看, 加總條件[卸模]~[架模]~[調產], 都在第11列, 若程式沒修改, 當然不正確
     另外,[前置]MAX-- 又要如何取???
3) 依據上方4個條件, 加總的位在在Q~AF欄, 所以Brr的欄數應變成 1 to 16 而不是 1 to 3
4) k = 1 to 3 這是固定的, 它會隨 j 值變化----j + k

自己再看看原來程式每一行, 若能一一理解, 再來說擴增需求~~
作者: Andy2483    時間: 2020-8-26 10:52

回復 21# 准提部林


1) 每次發帖都只提供簡化版, 當然得不到正確解答, 除非你真的已可自己修改程式或公式
擔心範例太混亂!前輩們不理! 調適中

2) 以這版本來看, 加總條件[卸模]~[架模]~[調產], 都在第11列, 若程式沒修改, 當然不正確
     另外,[前置]MAX-- 又要如何取???
不懂所以再問,[前置]MAX 是要分別從 每個品號(列)  [前置]段裡(標準.實際.誤差) 各取最大 如SHEET("流程項目").[K46]

3) 依據上方4個條件, 加總的位在在Q~AF欄, 所以Brr的欄數應變成 1 to 16 而不是 1 to 3
範例有改

4) k = 1 to 3 這是固定的, 它會隨 j 值變化----j + k
以為欄位擴大了 就該跟著變 不懂 請再指導

自己再看看原來程式每一行, 若能一一理解, 再來說擴增需求~~
感覺自己有理解 就改改看 ^_^

謝謝
作者: 准提部林    時間: 2020-8-26 11:12

本帖最後由 准提部林 於 2020-8-26 11:16 編輯

回復 22# Andy2483


[前置]MAX 是要分別從 每個品號(列)  [前置]段裡(標準.實際.誤差) 各取最大   

__取[標準]最大, 同時將該最大[標準]同組的[實際及誤差], 一起填入???
   還是三個分別取最大???

標準 100  實際 120 誤差 -20 (負數--怎比較)
標準 110  實際 100 誤差 10

取: 標準 110  實際 120 誤差 10 ???
作者: Andy2483    時間: 2020-8-26 11:44

回復 23# 准提部林


正 負一起比 取最大 ! 如果每欄都是負數 也是比最大數
例如
誤差值 5   ,10   ,20  ,6   .....取20
誤差值 -5   ,-10   ,-20  ,-6   .....取-5
誤差值- 5   ,10   ,-20  ,6   .....取10

負數是提前完成的意思,所以不讓變正數
正數是超過標準時間
作者: 准提部林    時間: 2020-8-26 13:19

回復 24# Andy2483

慢慢研究:
[attach]32474[/attach]
作者: Andy2483    時間: 2020-8-26 13:53

回復 25# 准提部林


謝謝前輩指導
Andy會認真研究 不枉費您的指導

另請教 範例當中的圖表列印範圍問題
1.以2013版的分頁預覽調整圖表來配合A4直印,也可產生PDF黨
2.再以2003版開啟時圖表位置就跑掉了
3.疑似版本問題!
作者: 准提部林    時間: 2020-8-26 16:49

回復 26# Andy2483

2003版只是提供參考用,
程式碼還是要搬到2013版, 免得因版本有些功能不可用~~
作者: Andy2483    時間: 2020-8-26 18:09

回復 27# 准提部林
了解
謝謝指導
這範例是專案實際要使用的統計工具檔
會依團隊實際需求情況作調整
有您的幫忙讓功能更完整 效能更好 代表團隊感謝版版.感謝各位前輩.
特別感謝您對Andy耐心的指導
作者: Andy2483    時間: 2021-7-27 10:26

回復 27# 准提部林


    謝謝前輩協助與指導!
1.生活總是忙忙碌碌的! 這帖已經過了11個月了!
2.工作告一段落的休息片刻,再回來學習這實用的程式碼!還是很吃力!
3.這段時間裡因系統轉換Oracle>SAP ,大量的Excel程式碼需要重寫!
4.因為又多又急著要上線使用,都只求能用就好!
效能需要提升!"
Andy學習進步的很慢!請 前輩們再指導!
謝謝 麻辣家族討論版版 的優質平台


Sub TEST_20200826()
Dim Arr, Brr, R&, C&, i&, j&, k%, T$
R = Cells(Rows.Count, "d").End(xlUp).Row '最後一行
C = Cells(12, Columns.Count).End(xlToLeft).Column '最後一欄
Arr = Range([A1], Cells(R, C)) '定義資料範圍--A1至整個區
'↑ Arr定義成整個區域更容易理解後面的邏輯規則!謝謝前輩!
ReDim Brr(1 To UBound(Arr) - 12, 1 To 20) '設空陣列
For i = 13 To UBound(Arr)
   For j = [AG1].Column To UBound(Arr, 2) Step 4
       T = Right(Split(Arr(11, j), "]")(0), 2)  '取[??]中的文字
       '↑ 因為特殊符號[ ]會影響執行結果!所以取裡面的字
       C = InStr("/前置//卸模//架模//調產/", T) - 1 '檢測各分項要填入Brr的位置
       '↑用T字串的所在的字數位置 決定T項目的總和放在Brr的位置! 真幸運能幫同事設計這份資料!謝謝!
       If C = 1 Then  '前置--取最大
          For k = 0 To 2
              If Arr(i, j + k) > Brr(i - 12, C + k) Then Brr(i - 12, C + k) = Arr(i, j + k)
          Next k
       ElseIf C >= 5 Then '其它項--累計
          For k = 0 To 2
              Brr(i - 12, C + k) = Brr(i - 12, C + k) + Arr(i, j + k) '各分項累計
              Brr(i - 12, 17 + k) = Brr(i - 12, 17 + k) + Arr(i, j + k) '合計
          Next k
       End If
    Next j
Next i
[M13].Resize(UBound(Brr), UBound(Brr, 2)) = Brr
End Sub
作者: Andy2483    時間: 2022-9-19 16:46

回復 25# 准提部林


    謝謝前輩指導
前輩的程式碼太精簡了
後輩由 簡化繁,逐步練習字典與陣列
今習得 字典.Add
  1. Option Explicit
  2. Sub TEST_20220919()
  3. Dim Arr, Brr, R&, C&, i&, j&, k%, T$, TT, Y
  4. TT = Timer
  5. R = Cells(Rows.Count, "d").End(xlUp).Row '最後一行
  6. C = Cells(12, Columns.Count).End(xlToLeft).Column '最後一欄
  7. Set Y = CreateObject("Scripting.Dictionary")
  8. For i = 1 To 13 Step 4
  9.    Y.Add Mid(Cells(11, i + 12), 2, 2), i
  10. Next
  11. Arr = Range([A1], Cells(R, C)) '定義資料範圍--A1至整個區
  12. ReDim Brr(1 To UBound(Arr) - 12, 1 To 20) '設空陣列
  13. For i = 13 To UBound(Arr)
  14.    For j = [AG1].Column To UBound(Arr, 2) Step 4
  15.        T = Right(Split(Arr(11, j), "]")(0), 2)  '取[??]中的文字
  16.        C = Y(T) '檢測各分項要填入Brr的位置
  17.        If C = 1 Then  '前置--取最大
  18.           For k = 0 To 2
  19.               If Arr(i, j + k) > Brr(i - 12, C + k) Then
  20.                  Brr(i - 12, C + k) = Arr(i, j + k)
  21.               End If
  22.           Next k
  23.        ElseIf C >= 5 Then '其它項--累計
  24.           For k = 0 To 2
  25.               Brr(i - 12, C + k) = Brr(i - 12, C + k) + Arr(i, j + k) '各分項累計
  26.               Brr(i - 12, 17 + k) = Brr(i - 12, 17 + k) + Arr(i, j + k) '合計
  27.           Next k
  28.        End If
  29.     Next j
  30. Next i
  31. [M13].Resize(UBound(Brr), UBound(Brr, 2)) = Brr
  32. MsgBox Timer - TT
複製代碼

作者: Andy2483    時間: 2022-9-20 09:01

回復 25# 准提部林


    請教前輩 關於 SET 問題
下方程式碼 加了SET 之後執行時間是沒加SET的3倍
Set Z = Z(1, 1).Resize(R, W)     '0.09秒
Z = Z(1, 1).Resize(R, W)            '0.03秒

1.是因為沒加SET是陣列,加了SET 是字典嗎?
2.什麼時候用 陣列?什麼時候用 字典?

謝謝前輩
  1. Option Explicit
  2. Sub TEST_20220920_2()
  3. Dim Brr, R&, C&, i&, j&, k%, T$, TT, Y, Z, W
  4. TT = Timer
  5. Set Y = CreateObject("Scripting.Dictionary")
  6. Set Z = CreateObject("Scripting.Dictionary")
  7. Set Z = ActiveSheet.Cells
  8. R = Z(Rows.Count, "D").End(xlUp).Row '最後一行
  9. W = Z(12, Columns.Count).End(xlToLeft).Column '最後一欄
  10. Set Z = Z(1, 1).Resize(R, W) '定義資料範圍--A1至整個區
  11. For i = 1 To 13 Step 4
  12.    Y.Add Mid(Z(11, i + 12), 2, 2), i
  13. Next
  14. ReDim Brr(1 To R - 12, 1 To 20) '設空陣列
  15. For i = 13 To R
  16.    For j = [AG1].Column To W Step 4
  17.        T = Right(Split(Z(11, j), "]")(0), 2)  '取[??]中的文字
  18.        C = Y(T) '檢測各分項要填入Brr的位置
  19.        If C = 1 Then  '前置--取最大
  20.           For k = 0 To 2
  21.               If Z(i, j + k) > Brr(i - 12, C + k) Then
  22.                  Brr(i - 12, C + k) = Z(i, j + k)
  23.               End If
  24.           Next k
  25.        ElseIf C >= 5 Then '其它項--累計
  26.           For k = 0 To 2
  27.               Brr(i - 12, C + k) = Brr(i - 12, C + k) + Z(i, j + k) '各分項累計
  28.               Brr(i - 12, 17 + k) = Brr(i - 12, 17 + k) + Z(i, j + k) '合計
  29.           Next k
  30.        End If
  31.     Next j
  32. Next i
  33. [M13].Resize(UBound(Brr), UBound(Brr, 2)) = Brr
  34. MsgBox Timer - TT
  35. End Sub
複製代碼

作者: Andy2483    時間: 2022-9-20 16:41

VBA中的陣列用法, 要早點了解,
最好也理解字典用法,
字典+陣列, 可處理很多種資料的處理及統計運算需求,
...
准提部林 發表於 2020-8-24 17:19



    謝謝前輩指導
後學駑鈍! 經過了2年才學到陣列語字典的一點點皮毛
勤能補拙!,永不放棄!
下列程式碼是今日學習到的字典與陣列技巧
再請前輩撥空再指導
  1. Option Explicit
  2. Sub TEST_20220920_3()
  3. Dim Brr, R&, C&, i&, j&, k%, T$, TT, Y, Z, W, P, Q
  4. Dim Crr, V, xR, n
  5. TT = Timer
  6. Set Y = CreateObject("Scripting.Dictionary")
  7. Set Z = CreateObject("Scripting.Dictionary")
  8. Set V = CreateObject("Scripting.Dictionary")
  9. Set Z = ActiveSheet.Cells
  10. For i = 1 To 4
  11.    Set V(i) = CreateObject("Scripting.Dictionary")
  12. Next
  13. R = Z(Rows.Count, "D").End(xlUp).Row '最後一行
  14. W = Z(12, Columns.Count).End(xlToLeft).Column '最後一欄
  15. Crr = Z(12, 33).Resize(R - 11, W - 32)
  16. Z = Z(1, 1).Resize(R, W) '定義資料範圍--A1至整個區
  17. For i = 1 To 13 Step 4
  18.    Y.Add Mid(Z(11, i + 12), 2, 2), (i + 3) / 4
  19. Next
  20. For i = 33 To W Step 4
  21.    P = Right(Split(Z(11, i), "]")(0), 2)
  22.    V(Y(P)).Add V(Y(P)).Count, i
  23. Next
  24. ReDim Brr(1 To R - 12, 1 To 20) '設空陣列
  25. For i = 13 To R
  26.    For Each xR In V(1)
  27.       If Z(i, V(1)(xR) + 1) > Brr(i - 12, 2) Then
  28.          Brr(i - 12, 1) = Z(i, V(1)(xR))
  29.          Brr(i - 12, 2) = Z(i, V(1)(xR) + 1)
  30.       End If
  31.       If Z(i, V(1)(xR) + 1) - Z(i, V(1)(xR)) > Brr(i - 12, 3) Then
  32.          Brr(i - 12, 3) = Z(i, V(1)(xR) + 1) - Z(i, V(1)(xR))
  33.       End If
  34.    Next
  35.    For n = 1 To 3
  36.       For Each xR In V(n + 1)
  37.          Brr(i - 12, n * 4 + 1) = Brr(i - 12, n * 4 + 1) + Z(i, V(n + 1)(xR))
  38.          Brr(i - 12, n * 4 + 2) = Brr(i - 12, n * 4 + 2) + Z(i, V(n + 1)(xR) + 1)
  39.          Brr(i - 12, n * 4 + 3) = Brr(i - 12, n * 4 + 2) - Brr(i - 12, n * 4 + 1)
  40.       Next
  41.    Next
  42.    For n = 1 To 3
  43.       For j = 1 To 3
  44.          Brr(i - 12, 16 + n) = Brr(i - 12, 16 + n) + Brr(i - 12, j * 4 + n)
  45.       Next
  46.    Next
  47. Next i
  48. [M13].Resize(UBound(Brr), UBound(Brr, 2)) = Brr
  49. MsgBox Timer - TT
  50. End Sub
複製代碼





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