[發問] 請問VBA Excel 陣列的問題?

pipi1968

我有個二維陣列如下:
"AA", "yes", "Cr", 111, 222
"BB", "No", "Dr" , 333, 444
"CC", "yes", "Bl", 111, 222
"AA", "yes", "Cr", 222, 333
"CC", "yes", "Bl", 333, 555
"CC", "yes", "Bl", 222, 111
"BB", "No", "Dr" , 444, 222
....

原則上"AA", 會搭配"yes", "Cr"；"BB",會搭配"No", "Dr"；"CC", 會搭配"yes", "Bl"
如果要根據第1欄("AA"、"BB"、"CC"),帶出第2欄("yes" or "No")、帶出第３欄("Cr"、 "Dr"、 "Bl")，並加總第4欄、第5欄
產生新陣列如下
"AA", "yes", "Cr", 333, 555
"BB", "No", "Dr" , 777, 666
"CC", "yes", "Bl" , 777 888
....

請問VBA Excel 該如何寫?
感謝大家的幫忙

Andy2483

回復 8# 准提部林


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

執行前:

下載 (48.15 KB)

2023-6-9 09:00

執行結果:

下載 (150.78 KB)

2023-6-9 09:01

Sub TEST()
Dim R&, N&, Arr, Brr, xD, T$, i&
'↑宣告變數
Sheets("Sheet2").UsedRange.Offset(1, 0).EntireRow.Delete
'↑令結果表標題列以下有使用的列刪除
Arr = Sheets("Sheet1").UsedRange
'↑令Arr變數是 二維陣列,以表1有使用格擴展最小方正區域儲存格值帶入陣列中
ReDim Brr(1 To UBound(Arr), 1 To 8)
'↑令Brr變數是 二維空陣列(縱向範圍同Arr陣列,橫向1~8)
Set xD = CreateObject("Scripting.Dictionary")
'↑令xD變數是 字典
For i = 3 To UBound(Arr)
'↑設順迴圈
    If Arr(i, 4) = "" Or Arr(i, 7) = "" Or Arr(i, 8) = "" Or Arr(i, 10) = "" Then GoTo 101
    '↑如果第(4,7,8,10)欄迴圈列Arr陣列值任一個是空的,就跳到標示 101位置繼續執行
    T = Arr(i, 7) & "<" & Arr(i, 10) & ">" & Arr(i, 8) & "|" & Arr(i, 4)
    '↑令T變數是Arr陣列值的組合字串
    R = xD(T)
    '↑令R變數是 T變數查xD字典item值
    If R = 0 Then
    '↑如果R變數是 0(初始值:代表T變數可能是初次納入字典)
       N = N + 1: R = N: xD(T) = N
       '↑令N變數累加1,令R變數是 N變數值(放結果在Brr陣列的列號),
       '令在xD字典的T變數key,對應的item變成 N變數值
       Brr(R, 1) = Arr(i, 7)
       Brr(R, 2) = Arr(i, 8)
       Brr(R, 3) = Arr(i, 10)
       Brr(R, 7) = Arr(i, 4)
       Brr(R, 8) = Split(T, "|")(0)
       '↑令Arr陣列值寫入Brr陣列中
    End If
    If Val(Arr(i, 14)) <> 0 Then Brr(R, 4) = Brr(R, 4) + Arr(i, 14)
    If Val(Arr(i, 21)) <> 0 Then Brr(R, 5) = Brr(R, 5) + Arr(i, 21)
    If Val(Arr(i, 22)) <> 0 Then Brr(R, 6) = Brr(R, 6) + Arr(i, 22)
    '↑如果Arr陣列值確認是非0的數值? True就給Brr陣列加總
101: Next i
If N > 0 Then [Sheet2!A2].Resize(N, 8) = Brr
'↑如果表1有符合條件的資料? 是就令從表2的[A2]開始的範圍寫入Brr陣列值,
'超過範圍的陣列值忽略
End Sub

pipi1968

謝謝各位高手的指導，問題已經解決了

pipi1968

多條件統計, 可用 字典檔+陣列,
不過哪幾個條件要說清楚,
yn2 如果有y 及 n, 是否視為不同條件?

index ...
准提部林 發表於 2016-3-16 11:02

原本是要用  姓名   品項   年度 3個值作為加總金額3 和 金額7 的條件
但不知要如何寫，所以就把這3欄合併起來作為加總金額3 和 金額7 的條件
等寫入excel後，再把它分開寫進原本的欄位

所以 姓名、品項、年度如有不同, 均視為不同條件
yn2 如果有y 及 n, 只是要作為另一判斷之用，不視為不同條件

准提部林

1. Sub TEST()
   
2. Dim R&, N&, Arr, Brr, xD, T$, i&
   
3. Sheets("Sheet2").UsedRange.Offset(1, 0).EntireRow.Delete
   
4. Arr = Sheets("Sheet1").UsedRange
   
5. ReDim Brr(1 To UBound(Arr), 1 To 8)
   
6. Set xD = CreateObject("Scripting.Dictionary")
   
7. For i = 3 To UBound(Arr)
   
8.     If Arr(i, 4) = "" Or Arr(i, 7) = "" Or Arr(i, 8) = "" Or Arr(i, 10) = "" Then GoTo 101
   
9.     T = Arr(i, 7) & "<" & Arr(i, 10) & ">" & Arr(i, 8) & "|" & Arr(i, 4)
   
10.     R = xD(T)
    
11.     If R = 0 Then
    
12.        N = N + 1: R = N: xD(T) = N
    
13.        Brr(R, 1) = Arr(i, 7)
    
14.        Brr(R, 2) = Arr(i, 8)
    
15.        Brr(R, 3) = Arr(i, 10)
    
16.        Brr(R, 7) = Arr(i, 4)
    
17.        Brr(R, 8) = Split(T, "|")(0)
    
18.     End If
    
19.     If Val(Arr(i, 14)) <> 0 Then Brr(R, 4) = Brr(R, 4) + Arr(i, 14)
    
20.     If Val(Arr(i, 21)) <> 0 Then Brr(R, 5) = Brr(R, 5) + Arr(i, 21)
    
21.     If Val(Arr(i, 22)) <> 0 Then Brr(R, 6) = Brr(R, 6) + Arr(i, 22)
    
22. 101: Next i
    
23. If N > 0 Then [Sheet2!A2].Resize(N, 8) = Brr
    
24. End Sub

複製代碼

lpk187

回復 4# pipi1968


    ar(0)(0)是陣列中的陣列，就是陣列裡面包著陣列，外層的陣列為ar(0)，ar為名稱第一個(0)為位址
，而內層的陣列為ar(0)(0)，ar(0)為名稱就類似ar1、ar2的使用，則第二個(0)為位址。
依此類推包多維陣列也可以包多著多維陣列，如ar(i,j)(k,l)

a1 = [a1:b10]
a2 = [d1:e10]
ar = Array(a1, a2)
arr = Array(ar)

准提部林

多條件統計, 可用 字典檔+陣列,
不過哪幾個條件要說清楚,
yn2 如果有y 及 n, 是否視為不同條件?

index 那欄做什麼用?

ML089

回復 4# pipi1968

你目前陣列宣告方式可以參考 Sub ex2()
   


Sub ex()
    Set d = CreateObject("Scripting.Dictionary")
    ar = Array(Array("AA", "yes", "Cr", 111, 222), _
               Array("BB", "No", "Dr", 333, 444), _
               Array("CC", "yes", "Bl", 111, 222), _
               Array("AA", "yes", "Cr", 222, 333), _
               Array("CC", "yes", "Bl", 333, 555), _
               Array("CC", "yes", "Bl", 222, 111), _
               Array("BB", "No", "Dr", 444, 222))

    For i = LBound(ar) To UBound(ar)
        If Not d.exists(ar(i)(0)) Then
            d(ar(i)(0)) = ar(i)
        Else
            a = d(ar(i)(0))
            a(3) = a(3) + ar(i)(3)
            a(4) = a(4) + ar(i)(4)
            d(ar(i)(0)) = a
        End If
    Next
    [a1].Resize(7, 5) = Application.Transpose(Application.Transpose(ar))
    [a9].Resize(d.Count, 5) = Application.Transpose(Application.Transpose(d.Items))
End Sub



Sub ex2()
    Set d = CreateObject("Scripting.Dictionary")
    ar = [A1:E7]

    For i = LBound(ar) To UBound(ar)
        If Not d.exists(ar(i, 1)) Then
            d(ar(i, 1)) = Array(ar(i, 1), ar(i, 2), ar(i, 3), ar(i, 4), ar(i, 5))
        Else
            a = d(ar(i, 1))
            a(3) = a(3) + ar(i, 4)
            a(4) = a(4) + ar(i, 5)
            d(ar(i, 1)) = a
        End If
    Next
    '    [a1].Resize(7, 5) = Application.Transpose(Application.Transpose(ar))
    [a13].Resize(d.Count, 5) = Application.Transpose(Application.Transpose(d.Items))
End Sub

pipi1968

另外請教一下，在我的檔案中，我可以用ar(0,0)的語法，叫出其值
但用ar(0)(0)就不行，這是什麼原因?

pipi1968

謝謝指教
但套用到我的資料卻出現 "陣列索引超出範圍"的訊息
       If Not d.exists(ar(i)(0)) Then
不知問題那裡有問題
煩請再指導
謝謝

PS:附上我的測試檔案(已寫好Sheet1 資料 讀進 ar的程式碼)
我測試的檔案, 好像不支援ar(0)(0)這種寫法
但如果只執行你的程式碼，又可以執行