Board logo

標題: [發問] 二維陣列的排序問題？ [打印本頁]
作者: wsx24680    時間: 2010-5-23 18:23     標題: 二維陣列的排序問題？

各位前輩：

資料如附件
[attach]803[/attach]

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

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

還請各位前輩指導。
作者: Hsieh    時間: 2010-5-23 22:20

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


  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    時間: 2010-5-24 01:29

回復 2# Hsieh

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

再次感謝！
作者: Hsieh    時間: 2010-5-24 08:49

回復 3# wsx24680


    如果結果是你要的
試試樞紐分析及資料彙總功能
作者: PD961A    時間: 2010-5-24 12:17

各位前輩：

資料如附件


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


請問樓主
您的資料只要將3個資料表彙總再用樞紐分析表就完成
可以請教您為何需要特地寫這個2維陣列嗎?
謝謝!
作者: wsx24680    時間: 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順序
**抓取的值可以不用含標題

[attach]863[/attach]
作者: Hsieh    時間: 2010-5-24 16:18

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

  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    時間: 2010-5-25 00:16

回復 7# Hsieh

感謝Hsieh版大快速的回覆，
試過了沒有什麼問題，若有不了解的地方再來請教。
作者: wsx24680    時間: 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版大如果改成此種顯示，如何修改程式。
作者: Hsieh    時間: 2010-6-23 09:04

回復 9# wsx24680


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



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