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

標題: 不同級別加總問題 [打印本頁]

作者: jomeow 時間: 2023-10-19 17:40 標題: 不同級別加總問題

想請教各位..

如果有幾組數字, >2000可以成為獨立一個金額, 如果不夠就加總.

請看圖片及附件比較清楚..

請好心人幫忙

><

作者: Andy2483 時間: 2023-10-20 10:30

本帖最後由 Andy2483 於 2023-10-20 12:57 編輯

回復 1# jomeow

謝謝前輩發表此主題與範例
後學藉此帖練習VBA陣列,練習方案如下,請前輩參考

Option Explicit
Sub TEST()
Dim Brr, Crr, v&, Q%, i&, j%, R&, c%, M&, A%, K&
K = 2000: Brr = Range([A1], ActiveSheet.UsedRange.Offset(1, 0))
ReDim Crr(1 To UBound(Brr), 1 To UBound(Brr, 2))
For j = 2 To UBound(Brr, 2)
c = c + 1: R = 0: Q = 0
If Brr(2, j) Like "BM *" = False Then Exit For
If Brr(3, j) = "" Then GoTo j01
For i = 3 To UBound(Brr)
   v = v + Val(Brr(i, j)): A = A + 1
   If Trim(Brr(i + 1, j)) = "" Then Q = 1
   If (v = K And A > 1) + (v > K) + (Q = 1 And v > 0) < 0 Then
      R = R + 1: Crr(R, c) = v: v = 0: A = 0
   End If
   If Q = 1 Then Exit For
Next
If M < R Then M = R
j01: Next
If M = 0 Then Exit Sub
[J:Z].ClearContents
[J1].Resize(M, c - 1) = Crr
Erase Brr, Crr
End Sub

作者: hcm19522 時間: 2023-10-20 11:43

https://hcm19522.blogspot.com/2023/10/11910.html

作者: 准提部林 時間: 2023-10-21 09:52

如圖//結果是什麼???
[attach]36902[/attach]

作者: jomeow 時間: 2023-10-24 11:00

回復 3# hcm19522

抱歉,, 小妹太笨... 我用了你的公式, 但計算不成功.. 沒數字出現..><

請再指教我可以嗎

作者: jomeow 時間: 2023-10-24 11:06

回復 2# Andy2483

你很厲害!!!!!!!!

成功了!!!!!!!

我用你的vba... 真的可以得到我想要的結果!!!!!!

感謝大大的出手幫助!!!!

m(_ _)m

作者: jomeow 時間: 2023-10-24 11:09

本帖最後由 jomeow 於 2023-10-24 11:21 編輯

回復 2# Andy2483

大大.. 我可不可以訊息你嗎?

或者你訊息我可以嗎?

因為.. 我想把你的vba的結果的位置, 改到我現在excel的位置.. 可以再向你請教嗎?

先謝謝喔!

作者: Andy2483 時間: 2023-10-24 11:26

回復 7# jomeow

在論壇上繼續做討論,後學知無不言

作者: jomeow 時間: 2023-10-24 11:27

回復 2# Andy2483

請幫忙看附件.. 因為我想把結果都放在 calculation這一頁...
[attach]36904[/attach]
先謝謝你幫忙!!

作者: jomeow 時間: 2023-10-24 11:28

回復 8# Andy2483

先謝謝你幫忙..

我上載了文件了...

作者: Andy2483 時間: 2023-10-24 11:40

本帖最後由 Andy2483 於 2023-10-24 11:58 編輯

回復 10# jomeow

[calculation!B22:F30].ClearContents
[calculation!B22].Resize(M, c - 1) = Crr
======================================

明確指向資料表與結果表版本

Option Explicit
Sub TEST_1()
Dim Brr, Crr, v&, Q%, i&, j%, R&, c%, M&, A%, K&, Ss As Worksheet, Sa As Worksheet
Set Ss = Sheets("data input"): Set Sa = Sheets("calculation")
K = 2000: Brr = Range(Ss.[A1], Ss.UsedRange.Offset(1, 0))
ReDim Crr(1 To UBound(Brr), 1 To UBound(Brr, 2))
For j = 2 To UBound(Brr, 2)
c = c + 1: R = 0: Q = 0
If Brr(2, j) Like "BM *" = False Then Exit For
If Brr(3, j) = "" Then GoTo j01
For i = 3 To UBound(Brr)
   v = v + Val(Brr(i, j)): A = A + 1
   If Trim(Brr(i + 1, j)) = "" Then Q = 1
   If (v = K And A > 1) + (v > K) + (Q = 1 And v > 0) < 0 Then
      R = R + 1: Crr(R, c) = v: v = 0: A = 0
   End If
   If Q = 1 Then Exit For
Next
If M < R Then M = R
j01: Next
If M = 0 Then Exit Sub
Sa.[B22:F30].ClearContents
Sa.[B22].Resize(M, c - 1) = Crr
Erase Brr, Crr
End Sub

作者: jomeow 時間: 2023-10-24 11:58

回復 11# Andy2483

謝謝大大的出手幫忙!

請問如有空.. 可不可以指教一下我vba內容的寫法可以嗎?

因為.. 我問了很多個群,, 只有你的答案才正確...

感恩你的幫助

作者: hcm19522 時間: 2023-10-24 12:00

回復 5# jomeow

數組公式 :複製公式不含 "=" ,貼上後加 "=" ;最前 "{" 代表 shift+ctrl+enter 三鍵一起按所產生 ,非程式裡面

作者: Andy2483 時間: 2023-10-24 12:22

回復 12# jomeow

下午撥空複習再註解給參考

作者: jomeow 時間: 2023-10-24 12:43

回復 13# hcm19522

謝謝大大的解釋... 現在明白多了..

作者: jomeow 時間: 2023-10-24 12:43

回復 14# Andy2483

謝謝你~

作者: jomeow 時間: 2023-10-24 12:47

回復 11# Andy2483

非常有用... 感謝~

不過我剛才就用了你修改的兩行, 也成功了..

作者: jomeow 時間: 2023-10-24 12:58

回復 13# hcm19522

你教我的公式.. 我成功了...

非常感謝你的幫助...

m(_ _)m

你們都很厲害.. 可不可以讓我認識你嗎

作者: Andy2483 時間: 2023-10-24 13:35

本帖最後由 Andy2483 於 2023-10-24 13:37 編輯

回復 16# jomeow

謝謝上論壇一起學習
Option Explicit
Sub TEST_1()
Dim Brr, Crr, v&, i&, R&, K&, M&, j%, Q%, c%, A%, Ss As Worksheet, Sa As Worksheet
'↑宣告變數:(Brr, Crr)是通用型變數,(v,i,R,K,M)是長整數,(j,Q,c,A)是短整數
'(Ss,Sa)是工作表變數
Set Ss = Sheets("data input"): Set Sa = Sheets("calculation")
'↑令Ss這工作表變數裝盛工作表 "data input"
'↑令Sa這工作表變數裝盛工作表 "calculation"
K = 2000: Brr = Range(Ss.[A1], Ss.UsedRange.Offset(1, 0))
'↑令K這長整數變數是常數2000
'↑令Brr這通用型變數是二維陣列,以Ss變數的[A1]到已使用儲存格下偏移一列,
'這範圍儲存格值帶入Brr陣列中
ReDim Crr(1 To UBound(Brr), 1 To UBound(Brr, 2))
'↑宣告這Crr通用型變數是二維空陣列:
'陣列上下範圍從索引號1到Brr陣列縱向最大索引列號
'陣列左右範圍從索引號1到Brr陣列橫向最大索引欄號
For j = 2 To UBound(Brr, 2)
'↑設順迴圈j:從2到 Brr陣列橫向最大索引欄號
c = c + 1: R = 0: Q = 0
'↑令c這短整數變數累加1
'↑令R這長整數歸零,令Q這長整數也歸零
If Brr(2, j) Like "BM *" = False Then Exit For
'↑如果第2列j迴圈欄Brr陣列值不是以 BM 字串開頭!就結束j的迴圈
If Brr(3, j) = "" Then GoTo j01
'↑如果第3列j迴圈欄Brr陣列值是空字元!就跳到標示 j01位置繼續執行
For i = 3 To UBound(Brr)
'↑設順迴圈i:從3到 Brr陣列綜向最大索引列號
   v = v + Val(Brr(i, j)): A = A + 1
   '↑令v這長整數變數累加(i迴圈列/j迴圈欄Brr陣列值)轉化的數值
   If Trim(Brr(i + 1, j)) = "" Then Q = 1
   '↑如果下一個迴圈陣列值是空字元!就令Q變數是1
   If (v = K And A > 1) + (v > K) + (Q = 1 And v > 0) < 0 Then
   '↑如果(v變數是剛好2000,而且是累加才剛好是2000的),或
   'v變數大於 2000,或v大於0 且已經是該欄最後一個數值,
   '如果以上三種條件的其中一種條件成立!
      R = R + 1: Crr(R, c) = v: v = 0: A = 0
      '↑令R變數累加1
      '↑令R變數列c變數欄Crr陣列值是v變數
      '↑令v變數歸零,A變數也歸零
   End If
   If Q = 1 Then Exit For
   '↑如果Q變數是1!就結束i迴圈
Next
If M < R Then M = R
'↑如果M變數小於R變數!就令M變數等於R變數
j01: Next
If M = 0 Then Exit Sub
'↑如果M變數是0!就結束程式執行
Sa.[B22:F30].ClearContents
'↑令Sa變數的[B22:F30]儲存格清除內容
Sa.[B22].Resize(M, c - 1) = Crr
'↑令Sa變數的[B22]向下擴展M變數列,向右擴展(c-1)欄,
'這範圍儲存格值是Crr陣列值
Erase Brr, Crr
'↑令釋放變數
End Sub

作者: jomeow 時間: 2023-10-24 15:07

回復 19# Andy2483

好詳細... 我要慢慢學習一下...

@o@

作者: jomeow 時間: 2023-10-24 15:20

[attach]36905[/attach][attach]36906[/attach]

回復 19# Andy2483

想請教兩位... 你的方法和另一位朋友的方法..

結果有不同..

如果.. 想把你的vba方法都與另一位朋友的方法的結果都一樣..

請問vba可以怎寫出來呢?

作者: jomeow 時間: 2023-10-24 15:21

[attach]36907[/attach][attach]36908[/attach]回復 13# hcm19522

回復 19# Andy2483

想請教兩位... 你的方法和另一位朋友的方法..

結果有不同..

如果.. 想把的offset方法都與另一位朋友的vba方法的結果都一樣..

請問offset可以怎寫出來呢?

作者: Andy2483 時間: 2023-10-24 15:30

回復 22# jomeow

兩者需求情境不一樣,我的VBA執行結果同1樓圖片的規則,與 hcm19522前輩的函數規則不同

作者: jomeow 時間: 2023-10-24 15:44

回復 23# Andy2483

請教一下,, 是不是分别就在於, 如果多於2000之後的數字,
你的vba也會加總... hcm19522前輩的就不加總呢?

作者: jomeow 時間: 2023-10-24 15:47

回復 jomeow

數組公式 :複製公式不含 "=" ,貼上後加 "=" ;最前 "{" 代表 shift+ctrl+enter 三 ...
hcm19522 發表於 2023-10-24 12:00

hcm19522前輩,, 想請教一下..

這個部份怎解說呢.. 我不太明白 MATCH(1=1,SUBTOTAL(9,OFFSET(B$3,,,ROW($1:$11)))-SUM(I$2:I2)>2000,)... 的用途呢?

=IFERROR(SUM(OFFSET(B$3,,, MATCH(1=1,SUBTOTAL(9,OFFSET(B$3,,,ROW($1:$11)))-SUM(I$2:I2)>2000,) ) ) -SUM(I$2:I2),"")

作者: Andy2483 時間: 2023-10-24 15:49

本帖最後由 Andy2483 於 2023-10-25 07:45 編輯

回復 24# jomeow

1樓範例與圖片有一個特別處:
如果累加才剛好是2000就不再加總後面的數值,填入2000,
另初始值是2000的卻要繼續累加
這很特別
後學也是矇到剛好跟範例相同的結果
所以需要確定清楚您的需求

作者: jomeow 時間: 2023-10-25 17:58

回復 jomeow

1樓範例與圖片有一個特別處:
如果累加才剛好是2000就不再加總後面的數值,填入2 ...
Andy2483 發表於 2023-10-24 15:49

ANDY前輩.. 你說得對呀..
所以我就想了解.. 如果是hcm19522前輩的計算方法.... vba會是怎樣才有這個效果呢?

作者: Andy2483 時間: 2023-10-25 19:09

回復 27# jomeow

If (v = K And A > 1) + (v > K) + (Q = 1 And v > 0) < 0 Then

改成

If (v > K) + (Q = 1 And v > 0) < 0 Then

作者: Andy2483 時間: 2023-10-26 07:53

本帖最後由 Andy2483 於 2023-10-26 08:00 編輯

回復 27# jomeow

[attach]36910[/attach]

輸入窗輸入0的執行結果:
[attach]36911[/attach]

輸入窗輸入1的執行結果:
[attach]36912[/attach]

Option Explicit
Sub TEST_1()
Dim Brr, Crr, v&, i&, R&, K&, M&, j%, Q%, c%, A%, Ss As Worksheet, Sa As Worksheet, iBox
'↑宣告變數:(Brr,Crr,iBox)是通用型變數,(v,i,R,K,M)是長整數,(j,Q,c,A)是短整數
'(Ss,Sa)是工作表變數
iBox = InputBox("0是不足2000繼續累加!" & vbLf & "1是累加剛好是2000的不再累加", "請輸入0 或1", 0)
'↑令iBox這通用型變數是輸入窗回傳值
If StrPtr(iBox) = 0 Then Exit Sub Else iBox = IIf(Val(iBox) > 0, 1, 0)
Set Ss = Sheets("data input"): Set Sa = Sheets("calculation")
'↑令Ss這工作表變數裝盛工作表 "data input"
'↑令Sa這工作表變數裝盛工作表 "calculation"
K = 2000: Brr = Range(Ss.[A1], Ss.UsedRange.Offset(1, 0))
'↑令K這長整數變數是常數2000
'↑令Brr這通用型變數是二維陣列,以Ss變數的[A1]到已使用儲存格下偏移一列,
'這範圍儲存格值帶入Brr陣列中
ReDim Crr(1 To UBound(Brr), 1 To UBound(Brr, 2))
'↑宣告這Crr通用型變數是二維空陣列:
'陣列上下範圍從索引號1到Brr陣列縱向最大索引列號
'陣列左有範圍從索引號1到Brr陣列橫向最大索引欄號
For j = 2 To UBound(Brr, 2)
'↑設順迴圈j:從2到 Brr陣列橫向最大索引欄號
c = c + 1: R = 0: Q = 0
'↑令c這短整數變數累加1
'↑令R這長整數歸零,令Q這長整數也歸零
If Brr(2, j) Like "BM *" = False Then Exit For
'↑如果第2列j迴圈欄Brr陣列值不是以 BM 字串開頭!就結束j的迴圈
If Brr(3, j) = "" Then GoTo j01
'↑如果第3列j迴圈欄Brr陣列值是空字元!就跳到標示 j01位置繼續執行
For i = 3 To UBound(Brr)
'↑設順迴圈i:從3到 Brr陣列綜向最大索引列號
   v = v + Val(Brr(i, j)): A = A + 1
   '↑令v這長整數變數累加(i迴圈列/j迴圈欄Brr陣列值)轉化的數值
   If Trim(Brr(i + 1, j)) = "" Then Q = 1
   '↑如果下一個迴圈陣列值是空字元!就令Q變數是1
   If (v = K And A > 1) * iBox + (v > K) + (Q = 1 And v > 0) < 0 Then
   '↑如果(v變數是剛好2000,而且是累加才剛好是2000且輸入是1),或
   'v變數大於 2000,或v大於0 且已經是該欄最後一個數值,
   '如果以上三種條件的其中一種條件成立!
      R = R + 1: Crr(R, c) = v: v = 0: A = 0
      '↑令R變數累加1
      '↑令R變數列c變數欄Crr陣列值是v變數
      '↑令v變數歸零,A變數也歸零
   End If
   If Q = 1 Then Exit For
   '↑如果Q變數是1!就結束i迴圈
Next
If M < R Then M = R
'↑如果M變數小於R變數!就令M變數等於R變數
j01: Next
If M = 0 Then Exit Sub
'↑如果M變數是0!就結束程式執行
Sa.[B22:F30].ClearContents
'↑令Sa變數的[B22:F30]儲存格清除內容
Sa.[B22].Resize(M, c - 1) = Crr
'↑令Sa變數的[B22]向下擴展M變數列,向右擴展(c-1)欄,
'這範圍儲存格值是Crr陣列值
Application.Goto Sa.[B22].Resize(M, c - 1)
'↑令視窗跳到結果位置
Erase Brr, Crr
'↑令釋放變數
End Sub

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