帖子: 9
主題: 2
精華: 0
積分: 50
點名: 0
作業系統: win7
軟體版本: sp1
閱讀權限: 20
註冊時間: 2015-9-21
最後登錄: 2020-7-23

1^# 跳轉到 » 倒序看帖

字體大小: tT

發表於 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

版主 Rank: 7 Rank: 7 Rank: 7

帖子: 2025
主題: 13
精華: 0
積分: 2053
點名: 0
作業系統: WIN7
軟體版本: Office2007
閱讀權限: 100
性別: 男
來自: 台北市
註冊時間: 2011-3-2
最後登錄: 2024-3-14

論壇榮譽勳章論壇贊助勳章熱烈參與勳章 2014馬年全勤獎章 2015羊年全勤獎章 2016猴年全勤獎章

2^#

發表於 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

複製代碼

{...} 表示需要用 CTRL+SHIFT+ENTER 三鍵輸入公式

TOP

pipi1968

中學生 Rank: 2

帖子: 9
主題: 2
精華: 0
積分: 50
點名: 0
作業系統: win7
軟體版本: sp1
閱讀權限: 20
註冊時間: 2015-9-21
最後登錄: 2020-7-23

3^#

發表於 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)這種寫法
但如果只執行你的程式碼，又可以執行

VBA-1.rar (25.15 KB)

TOP

pipi1968

中學生 Rank: 2

帖子: 9
主題: 2
精華: 0
積分: 50
點名: 0
作業系統: win7
軟體版本: sp1
閱讀權限: 20
註冊時間: 2015-9-21
最後登錄: 2020-7-23

4^#

發表於 2016-3-16 07:58 | 只看該作者

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

TOP

ML089

版主 Rank: 7 Rank: 7 Rank: 7

帖子: 2025
主題: 13
精華: 0
積分: 2053
點名: 0
作業系統: WIN7
軟體版本: Office2007
閱讀權限: 100
性別: 男
來自: 台北市
註冊時間: 2011-3-2
最後登錄: 2024-3-14

論壇榮譽勳章論壇贊助勳章熱烈參與勳章 2014馬年全勤獎章 2015羊年全勤獎章 2016猴年全勤獎章

5^#

發表於 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

{...} 表示需要用 CTRL+SHIFT+ENTER 三鍵輸入公式

TOP

准提部林

版主 Rank: 7 Rank: 7 Rank: 7

帖子: 2836
主題: 10
精華: 0
積分: 2892
點名: 0
作業系統: 〔略〕
軟體版本: 〔略〕
閱讀權限: 100
性別: 男
來自: 〔略〕
註冊時間: 2013-5-13
最後登錄: 2024-11-30

6^#

發表於 2016-3-16 11:02 | 只看該作者

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

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

index 那欄做什麼用?

TOP

lpk187

高中生 Rank: 3 Rank: 3

帖子: 552
主題: 3
精華: 0
積分: 578
點名: 0
作業系統: win7
軟體版本: office 2010
閱讀權限: 50
性別: 男
註冊時間: 2015-2-8
最後登錄: 2024-7-9

2016猴年全勤獎章 2015羊年全勤獎章熱烈參與勳章

7^#

發表於 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)

TOP

准提部林

版主 Rank: 7 Rank: 7 Rank: 7

帖子: 2836
主題: 10
精華: 0
積分: 2892
點名: 0
作業系統: 〔略〕
軟體版本: 〔略〕
閱讀權限: 100
性別: 男
來自: 〔略〕
註冊時間: 2013-5-13
最後登錄: 2024-11-30

8^#

發表於 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