[發問] 如何取合計資料

dou10801

如何取合計資料,請先進指點,感恩.

samwang

回復 1# dou10801
請測試看看，謝謝
Sub test()
Dim Arr, Brr, T, T1, i&, n%
Arr = Sheets(1).[a1].CurrentRegion
ReDim Brr(1 To UBound(Arr), 1 To 8)
For i = 5 To UBound(Arr)
    If Arr(i, 1) <> "" Then
        n = n + 1: Brr(n, 1) = Arr(i, 1)
        Brr(n, 2) = Arr(i, 2): Brr(n, 3) = Arr(i, 5)
        Brr(n, 4) = Arr(i, 6): Brr(n, 5) = Arr(i, 7)
        For i2 = i To UBound(Arr)
            If InStr(Arr(i2, 7), "合計") Then
                Brr(n, 7) = Arr(i2, 11): Brr(n, 8) = Arr(i2, 12)
                T = T + Val(Brr(n, 7)): T1 = T1 + Val(Brr(n, 8))
                Exit For
            End If
        Next
    End If
Next
Brr(n + 1, 7) = T: Brr(n + 1, 8) = T1
Sheets(3).[j1].Resize(n + 1, 8) = Brr
End Sub

准提部林

Sub TEST_A1()
Dim Arr, Brr, i&, j%, N&, S1, S2
Arr = Range(Sheets(1).[a1], Sheets(1).Cells(Rows.Count, "L").End(3))
ReDim Brr(1 To UBound(Arr), 1 To 8)
For i = 5 To UBound(Arr)
    If Arr(i, 1) <> "" Then
       N = N + 1
       For j = 1 To 5
           Brr(N, j) = Arr(i, Mid(12567, j, 1))
       Next j
    End If
    If Arr(i, 7) = "合計:" And N > 0 Then
       Brr(N, 7) = Arr(i, 11): Brr(N, 8) = Arr(i, 12)
       S1 = S1 + Arr(i, 11): S2 = S2 + Arr(i, 12)
    End If
Next i
N = N + 1: Brr(N, 2) = "總計": Brr(N, 7) = S1: Brr(N, 8) = S2
Sheets(3).[a:h].ClearContents
If N > 0 Then Sheets(3).[a1].Resize(N, 8) = Brr
End Sub

dou10801

感謝samwang. 准提部林 二位指導,感恩.

Andy2483

回復 3# 准提部林


    謝謝論壇,謝謝前輩指導
後學藉此帖學習前輩的方案,學習心得註解如下,請前輩再指導

資料表:

下載 (186.37 KB)

2023-11-20 08:44

執行結果:

下載 (156.62 KB)

2023-11-20 08:45

Option Explicit
Sub TEST_A1()
Dim Arr, Brr, i&, j%, N&, S1, S2
'↑宣告變數&是長整數,%是短整數,沒有符號的是通用型變數
Arr = Range(Sheets(1).[A1], Sheets(1).Cells(Rows.Count, "L").End(3))
'↑令Arr這通用型變數是 表1的[A1]到 L欄最後有內容儲存格範圍值的二維陣列
ReDim Brr(1 To UBound(Arr), 1 To 8)
'↑宣告Brr這通用型變數是二維空陣列,縱向索引號從1到 Arr縱向最大索引列號,
'橫向1~8索引號
For i = 5 To UBound(Arr)
'↑設順迴圈!i從1到 Arr縱向最大索引列號
    If Arr(i, 1) <> "" Then
    '↑如果i迴圈列1欄陣列值不是空字元?
       N = N + 1
       '↑令N這長整數變數累加1
       For j = 1 To 5
       '↑設順迴圈!j從1~5
           Brr(N, j) = Arr(i, Mid(12567, j, 1))
           '↑令Arr陣列i迴圈列1,2,5,6,7欄陣列值,帶入Brr陣列的
           'N變數列的1,2,3,4,5欄
       Next j
    End If
    If Arr(i, 7) = "合計:" And N > 0 Then
    '↑如果i迴圈列第7欄Arr陣列值是 "合計:",而且N變數大於0??
       Brr(N, 7) = Arr(i, 11): Brr(N, 8) = Arr(i, 12)
       '↑令N變數列第7欄Brr陣列值是 i迴圈列第11欄Arr陣列值
       '↑令N變數列第8欄Brr陣列值是 i迴圈列第12欄Arr陣列值
       S1 = S1 + Arr(i, 11): S2 = S2 + Arr(i, 12)
       '↑令S1變數是自身值累加 i迴圈列第11欄Arr陣列值
       '↑令S2變數是自身值累加 i迴圈列第12欄Arr陣列值
    End If
Next i
N = N + 1: Brr(N, 2) = "總計": Brr(N, 7) = S1: Brr(N, 8) = S2
'↑令N變數累加1,令N變數列第2欄Brr陣列值是 "總計"字串
'令N變數列第7欄Brr陣列值是S1變數,令N變數列第8欄Brr陣列值是S2變數
Sheets(3).[a:h].ClearContents
'↑令表3的[A:H]儲存格清除內容
If N > 0 Then Sheets(3).[A1].Resize(N, 8) = Brr
'↑如果N變數大於0?
'True就令表3的[A1]擴展向下N變數列,向右8欄範圍儲存格值,以Brr陣列帶入
End Sub
'=======================================================
以下是練習方案,請前輩再指教

Option Explicit
Sub TEST()
Dim Brr, Q, B1%, B2%, i&, j%, R&
Brr = Range(工作表1.[A1], 工作表1.Cells(Rows.Count, 12).End(xlUp))
Q = [{1,2,5,6,7}]
For i = 5 To UBound(Brr)
   B1 = Brr(i, 2) <> "": B2 = Brr(i, 7) = "合計:"
   If B1 Then
      R = R + 1: Brr(R, 6) = ""
      For j = 1 To 5: Brr(R, j) = Brr(i, Q(j)): Next
   End If
   If B2 Then Brr(R, 7) = Brr(i, 11): Brr(R, 8) = Brr(i, 12)
i01: Next
If R = 0 Then Exit Sub
With 工作表4.[A1].Resize(R, 8)
   .EntireColumn.ClearContents
   .Value = Brr
   .Item(.Count + 2) = "合計"
   .Item(.Count + 7).Resize(, 2) = "=SUM(G1:G" & R & ")"
End With
End Sub

hcm19522

(輸入編號12036) google網址:https://hcm19522.blogspot.com/