[發問] 二維陣列的排序問題？

帖子: 4901
主題: 44
精華: 24
積分: 4916
點名: 254
作業系統: Windows 7
軟體版本: Office 20xx
閱讀權限: 150
性別: 男
來自: 台北
註冊時間: 2010-4-30
最後登錄: 2024-11-23

2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章 2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱心公益勳章 2011兔年全勤獎章

2^#

發表於 2010-5-23 22:20 | 只看該作者

回復 1# wsx24680

不知是不是這個意思

Sub Ex_1() 'Sheet2跟Sheet3相加
Dim A As Range
Set d = CreateObject("Scripting.Dictionary")
d("Item") = Array("ITEM", "NO.", "COUNT")
For Each Sh In Sheets(Array("Sheet2", "Sheet3"))
With Sh
For Each A In .Range(.[A2], .[A65536].End(xlUp))
If IsEmpty(d(A & A.Offset(, 1))) Then
d(A & A.Offset(, 1)) = Array(A, A.Offset(, 1), A.Offset(, 2))
Else
ar = d(A & A.Offset(, 1))
ar(2) = ar(2) + A.Offset(, 2)
d(A & A.Offset(, 1)) = ar
End If
Next
End With
Next
With Sheet3.[F1].Resize(d.Count, 3)
.Value = Application.Transpose(Application.Transpose(d.items))
.Sort key1:=.Cells(1, 1), Header:=xlYes
End With
End Sub
Sub Ex_2() 'Sheet1計數
Dim A As Range
Set d = CreateObject("Scripting.Dictionary")
With Sheet1
d("Item") = Array("ITEM", "NO.", "COUNT")
For Each A In .Range(.[A2], .[A65536].End(xlUp))
If IsEmpty(d(A & A.Offset(, 1))) Then
d(A & A.Offset(, 1)) = Array(A, A.Offset(, 1), 1)
Else
ar = d(A & A.Offset(, 1))
ar(2) = ar(2) + 1
d(A & A.Offset(, 1)) = ar
End If
Next
End With
With Sheet1.[F1].Resize(d.Count, 3)
.Value = Application.Transpose(Application.Transpose(d.items))
.Sort key1:=.Cells(1, 1), key2:=.Cells(1, 2), Header:=xlYes
End With
End Sub

複製代碼

學海無涯_不恥下問

帖子: 17
主題: 4
精華: 0
積分: 51
點名: 0
作業系統: win7
軟體版本: office2007
閱讀權限: 20
註冊時間: 2010-5-20
最後登錄: 2014-7-9

3^#

發表於 2010-5-24 01:29 | 只看該作者

回復 2# Hsieh

Hsieh版大：
感謝您快速的回覆，程式執行過後沒什麼問題，
由於初學對VBA中的物件還不清楚，有幾個地方小弟還要研究一下。

再次感謝！

帖子: 4901
主題: 44
精華: 24
積分: 4916
點名: 254
作業系統: Windows 7
軟體版本: Office 20xx
閱讀權限: 150
性別: 男
來自: 台北
註冊時間: 2010-4-30
最後登錄: 2024-11-23

2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章 2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱心公益勳章 2011兔年全勤獎章

4^#

發表於 2010-5-24 08:49 | 只看該作者

回復 3# wsx24680

如果結果是你要的
試試樞紐分析及資料彙總功能

學海無涯_不恥下問

版主 Rank: 7 Rank: 7 Rank: 7

PD961A

帖子: 1180
主題: 204
精華: 0
積分: 1051
點名: 0
作業系統: Mac.OS10.6
軟體版本: Office 2003
閱讀權限: 100
性別: 男
註冊時間: 2010-5-3
最後登錄: 2012-9-19

2012龍年全勤獎章論壇貢獻勳章終身榮譽會員勳章好學求知勳章熱烈參與勳章 2011兔年全勤獎章

5^#

發表於 2010-5-24 12:17 | 只看該作者

各位前輩：

資料如附件

小弟目前的作法是將SHEET2中的資料寫入一個二維的陣列，但是如有新的資料列 ...
wsx24680 發表於 2010-5-23 18:23

請問樓主
您的資料只要將3個資料表彙總再用樞紐分析表就完成
可以請教您為何需要特地寫這個2維陣列嗎?
謝謝!

帖子: 17
主題: 4
精華: 0
積分: 51
點名: 0
作業系統: win7
軟體版本: office2007
閱讀權限: 20
註冊時間: 2010-5-20
最後登錄: 2014-7-9

6^#

發表於 2010-5-24 15:50 | 只看該作者

回復 5# PD961A

PD961A前輩：

這個附件中的資料來源是已經整理過的了，實際的資料表較大，
資料內容也不完整(item欄位有些是空白，只有在第一個才有，下面相同item的被省略)，
而且資料之間有一些不必要的空行。

因此我原本的想法是想要利用一個二維的陣列來把sheet2中的資料儲存到陣列
如果是空白就跳過，如果item是空白但是no.欄位跟num欄位中有值，
就視為與上個item中的值相同，將其item中的值補上，讓其資料完整。

還有一點是我當初提問時沒有想到的，在這先跟Hsieh版大說聲抱歉…
當初沒有說明清楚，我想要的結果應該是要item攔是要照sheet2中的順序來排序，
而no.欄則由小到大排序，num欄只要將其相同的加總。

將sheet3中的資料加入並照上面的規則來排序，
小弟目前有想到的概念是應該要再利用一個二維陣來當暫存，
但還沒想到要如何寫成程式，或是各位前輩有什麼更好的方法還請各位前輩指點。

重新附上一個新的附件，內容有些修正，想要的結果如sheet3中的J欄到L欄。
**內含Hsieh版大先前的程式碼
**修改sheet2的item順序
**抓取的值可以不用含標題

Book1.zip (21.82 KB)

帖子: 4901
主題: 44
精華: 24
積分: 4916
點名: 254
作業系統: Windows 7
軟體版本: Office 20xx
閱讀權限: 150
性別: 男
來自: 台北
註冊時間: 2010-4-30
最後登錄: 2024-11-23

2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章 2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱心公益勳章 2011兔年全勤獎章

7^#

發表於 2010-5-24 16:18 | 只看該作者

回復 6# wsx24680

Sub Ex_1() 'Sheet2跟Sheet3相加
Dim A As Range, Ay()
Set d = CreateObject("Scripting.Dictionary")
Set d1 = CreateObject("Scripting.Dictionary")
For Each Sh In Sheets(Array("Sheet2", "Sheet3"))
With Sh
For Each A In .Range(.[A2], .[A65536].End(xlUp))
If IsEmpty(d(A & A.Offset(, 1))) Then
d(A & A.Offset(, 1)) = Array(A, A.Offset(, 1), A.Offset(, 2))
d1(A.Value) = ""
Else
ar = d(A & A.Offset(, 1))
ar(2) = ar(2) + A.Offset(, 2)
d(A & A.Offset(, 1)) = ar
End If
Next
End With
Next
With Sheet3
.Columns("F:H") = ""
Set A = .[F1]
For Each ky In d1.keys
For Each key1 In d.keys
If d(key1)(0) = ky Then
ReDim Preserve Ay(s)
Ay(s) = d(key1)
s = s + 1
End If
Next
With A.Resize(s, 3)
.Value = Application.Transpose(Application.Transpose(Ay))
.Sort key1:=.Cells(1, 2), header:=xlNo
End With
Erase Ay: s = 0: Set A = .[F65536].End(xlUp).Offset(1, 0)
Next
End With
End Sub

複製代碼

學海無涯_不恥下問

帖子: 17
主題: 4
精華: 0
積分: 51
點名: 0
作業系統: win7
軟體版本: office2007
閱讀權限: 20
註冊時間: 2010-5-20
最後登錄: 2014-7-9

8^#

發表於 2010-5-25 00:16 | 只看該作者

回復 7# Hsieh

感謝Hsieh版大快速的回覆，
試過了沒有什麼問題，若有不了解的地方再來請教。

帖子: 17
主題: 4
精華: 0
積分: 51
點名: 0
作業系統: win7
軟體版本: office2007
閱讀權限: 20
註冊時間: 2010-5-20
最後登錄: 2014-7-9

9^#

發表於 2010-6-23 08:58 | 只看該作者

回復 7# Hsieh

Hsieh版大：
請問一下，因為將SHEET2跟SHEET3相加後看不出來哪一筆是兩張SHEET都有相加過的，
希望能顯示成
DDD 2 20+10
所以小弟試著修改將Hsieh版大程式碼的第14行改成
ar(2) = A.Offset(, 2) + "+" + ar(2)
但出現錯誤，請問Hsieh版大如果改成此種顯示，如何修改程式。

帖子: 4901
主題: 44
精華: 24
積分: 4916
點名: 254
作業系統: Windows 7
軟體版本: Office 20xx
閱讀權限: 150
性別: 男
來自: 台北
註冊時間: 2010-4-30
最後登錄: 2024-11-23

2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章 2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱心公益勳章 2011兔年全勤獎章

10^#

發表於 2010-6-23 09:04 | 只看該作者

回復 9# wsx24680

ar(2) = A.Offset(, 2) + "+" + ar(2)
因為你市要字串連結
應為ar(2) = A.Offset(, 2) & "+" & ar(2)

學海無涯_不恥下問