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

wsx24680

各位前輩：

資料如附件
Book1.rar (13.16 KB)

下載次數: 13

2010-5-23 18:22

小弟目前的作法是將SHEET2中的資料寫入一個二維的陣列，但是如有新的資料列如SHEET3，
要如何將其寫入到陣列中而且資料按照ITEM欄重新排列，並將相同的ITEM跟NO.加總NUM的量。

另外，SHEET1中的資料如何計算相同的計算有幾個？列如：ITEM：DDD & NO.：1的共有45筆
這也可以用Dictionary的方式來做嗎？

還請各位前輩指導。

Hsieh

回復 1# wsx24680


   不知是不是這個意思

1. Sub Ex_1() 'Sheet2跟Sheet3相加
   
2. Dim A As Range
   
3. Set d = CreateObject("Scripting.Dictionary")
   
4. d("Item") = Array("ITEM", "NO.", "COUNT")
   
5. For Each Sh In Sheets(Array("Sheet2", "Sheet3"))
   
6. With Sh
   
7. For Each A In .Range(.[A2], .[A65536].End(xlUp))
   
8.   If IsEmpty(d(A & A.Offset(, 1))) Then
   
9.      d(A & A.Offset(, 1)) = Array(A, A.Offset(, 1), A.Offset(, 2))
   
10.      Else
    
11.      ar = d(A & A.Offset(, 1))
    
12.      ar(2) = ar(2) + A.Offset(, 2)
    
13.      d(A & A.Offset(, 1)) = ar
    
14.   End If
    
15. Next
    
16. End With
    
17. Next
    
18. With Sheet3.[F1].Resize(d.Count, 3)
    
19. .Value = Application.Transpose(Application.Transpose(d.items))
    
20. .Sort key1:=.Cells(1, 1), Header:=xlYes
    
21. End With
    
22. End Sub
    
23. 
    
24. 
    
25. Sub Ex_2() 'Sheet1計數
    
26. Dim A As Range
    
27. Set d = CreateObject("Scripting.Dictionary")
    
28. With Sheet1
    
29. d("Item") = Array("ITEM", "NO.", "COUNT")
    
30. For Each A In .Range(.[A2], .[A65536].End(xlUp))
    
31.   If IsEmpty(d(A & A.Offset(, 1))) Then
    
32.      d(A & A.Offset(, 1)) = Array(A, A.Offset(, 1), 1)
    
33.      Else
    
34.      ar = d(A & A.Offset(, 1))
    
35.      ar(2) = ar(2) + 1
    
36.      d(A & A.Offset(, 1)) = ar
    
37.   End If
    
38. Next
    
39. End With
    
40. With Sheet1.[F1].Resize(d.Count, 3)
    
41. .Value = Application.Transpose(Application.Transpose(d.items))
    
42. .Sort key1:=.Cells(1, 1), key2:=.Cells(1, 2), Header:=xlYes
    
43. End With
    
44. End Sub

複製代碼

wsx24680

回復 2# Hsieh

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

再次感謝！

Hsieh

回復 3# wsx24680


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

PD961A

各位前輩：

資料如附件


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

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

wsx24680

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

下載次數: 11

2010-5-24 15:45

Hsieh

回復 6# wsx24680

1. Sub Ex_1() 'Sheet2跟Sheet3相加
   
2. Dim A As Range, Ay()
   
3. Set d = CreateObject("Scripting.Dictionary")
   
4. Set d1 = CreateObject("Scripting.Dictionary")
   
5. 
   
6. For Each Sh In Sheets(Array("Sheet2", "Sheet3"))
   
7. With Sh
   
8. For Each A In .Range(.[A2], .[A65536].End(xlUp))
   
9.   If IsEmpty(d(A & A.Offset(, 1))) Then
   
10.      d(A & A.Offset(, 1)) = Array(A, A.Offset(, 1), A.Offset(, 2))
    
11.      d1(A.Value) = ""
    
12.      Else
    
13.      ar = d(A & A.Offset(, 1))
    
14.      ar(2) = ar(2) + A.Offset(, 2)
    
15.      d(A & A.Offset(, 1)) = ar
    
16.   End If
    
17. Next
    
18. End With
    
19. Next
    
20. With Sheet3
    
21. .Columns("F:H") = ""
    
22. Set A = .[F1]
    
23. For Each ky In d1.keys
    
24.    For Each key1 In d.keys
    
25.       If d(key1)(0) = ky Then
    
26.       ReDim Preserve Ay(s)
    
27.       Ay(s) = d(key1)
    
28.       s = s + 1
    
29.       End If
    
30.     Next
    
31. With A.Resize(s, 3)
    
32. .Value = Application.Transpose(Application.Transpose(Ay))
    
33. .Sort key1:=.Cells(1, 2), header:=xlNo
    
34. End With
    
35. Erase Ay: s = 0: Set A = .[F65536].End(xlUp).Offset(1, 0)
    
36. Next
    
37. End With
    
38. End Sub

複製代碼

wsx24680

回復 7# Hsieh

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

wsx24680

回復 7# Hsieh


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

Hsieh

回復 9# wsx24680


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