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

標題: [發問] 請問VBA Excel 陣列的問題? [打印本頁]

作者: pipi1968 時間: 2016-3-15 21:03 標題: 請問VBA Excel 陣列的問題?

本帖最後由 pipi1968 於 2016-3-15 21:04 編輯

我有個二維陣列如下:
"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 該如何寫?
感謝大家的幫忙

作者: ML089 時間: 2016-3-15 22:31

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

複製代碼

作者: pipi1968 時間: 2016-3-16 00:58

本帖最後由 pipi1968 於 2016-3-16 00:59 編輯

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

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

作者: pipi1968 時間: 2016-3-16 07:58

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

作者: ML089 時間: 2016-3-16 09:13

回復 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

作者: 准提部林 時間: 2016-3-16 11:02

本帖最後由准提部林於 2016-3-16 11:04 編輯

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

index 那欄做什麼用?

作者: lpk187 時間: 2016-3-16 11:44

回復 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)

作者: 准提部林 時間: 2016-3-16 12:09

Sub TEST()
Dim R&, N&, Arr, Brr, xD, T$, i&
Sheets("Sheet2").UsedRange.Offset(1, 0).EntireRow.Delete
Arr = Sheets("Sheet1").UsedRange
ReDim Brr(1 To UBound(Arr), 1 To 8)
Set xD = CreateObject("Scripting.Dictionary")
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
T = Arr(i, 7) & "<" & Arr(i, 10) & ">" & Arr(i, 8) & "|" & Arr(i, 4)
R = xD(T)
If R = 0 Then
N = N + 1: R = N: xD(T) = 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)
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)
101: Next i
If N > 0 Then [Sheet2!A2].Resize(N, 8) = Brr
End Sub

複製代碼

作者: pipi1968 時間: 2016-3-16 12:37

本帖最後由 pipi1968 於 2016-3-16 12:40 編輯

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

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

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

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

作者: pipi1968 時間: 2016-3-17 10:09

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

作者: Andy2483 時間: 2023-6-9 09:02

回復 8# 准提部林

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

執行前:
[attach]36560[/attach]

執行結果:
[attach]36561[/attach]

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

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