返回列表 上一主題 發帖

[發問]將兩陣列依順序合併問題

FAlonso

帖子
135 
主題
19 
精華
0 
積分
165 
點名
0  
作業系統
XP 
軟體版本
2003 
閱讀權限
20 
性別
男 
來自
香港 
註冊時間
2010-12-9 
最後登錄
2012-8-27 
1# 跳轉到 »
發表於 2011-1-14 15:11 | 顯示全部帖子
回復 1# asus103
  1. Sub merge_rank()
  2. Dim myobject As Object
  3. Dim myrange As Range
  4. Dim i As Integer

  6. Set myobject = CreateObject("scripting.dictionary")

  8. For i = 1 To 2
  9. With Worksheets("sheet" & i)
  10. For Each myrange In .Range(.[a1], .[a1].End(xlToRight))
  11. myobject(myrange.Value) = myrange.Offset(1).Value
  12. Next
  13. End With
  14. Next

  16. With Sheet3
  17. For i = 1 To myobject.Count
  18. .Cells(1, i).Value = Application.Small(myobject.keys, i)
  19. .Cells(2, i).Value = myobject.Item(Application.Small(myobject.keys, i))
  20. Next
  21. End With

  23. Set myobject = Nothing

  25. End Sub
複製代碼
80 字節以內
不支持自定義 Discuz! 代碼

TOP

FAlonso

帖子
135 
主題
19 
精華
0 
積分
165 
點名
0  
作業系統
XP 
軟體版本
2003 
閱讀權限
20 
性別
男 
來自
香港 
註冊時間
2010-12-9 
最後登錄
2012-8-27 
2#
發表於 2011-1-14 20:28 | 顯示全部帖子
[版主管理留言]
  • Hsieh(2011-1-14 20:32): 先提出你的解決方式，再解開權限

回復 14# Hsieh
下載不到
80 字節以內
不支持自定義 Discuz! 代碼

TOP

FAlonso

帖子
135 
主題
19 
精華
0 
積分
165 
點名
0  
作業系統
XP 
軟體版本
2003 
閱讀權限
20 
性別
男 
來自
香港 
註冊時間
2010-12-9 
最後登錄
2012-8-27 
3#
發表於 2011-1-15 11:49 | 顯示全部帖子
[版主管理留言]
  • Hsieh(2011-1-15 11:59): 已開放下載，程式碼也顯示了 參考看看 多謝參與討論

回復 14# Hsieh
  1. Sub merge_rank()
  2. Dim myobject As Object, myobject2 As Object
  3. Dim myrange As Range
  4. Dim i As Integer, j As Integer

  6. Set myobject = CreateObject("scripting.dictionary")
  7. Set myobject2 = CreateObject("scripting.dictionary")

  9. With Sheet4
  10. For Each myrange In .Range(.[a1], .[a1].End(xlToRight))
  11. myobject(myrange.Value) = myobject(myrange.Value) + 1      'myrange.value為第1 row某數字,myobject作為計數器
  12. myobject2(myrange.Value & "," & myobject(myrange.Value)) = myrange.Offset(1).Value  myobject2輸入第2 row的數字(index為myrange.Value & "," & myobject(myrange.Value,即數字及其出現次數)
  13. Next
  14. End With

  16. With Sheet5
  17. .Activate
  18. .Range("a1").Activate
  19. For i = 1 To myobject.Count   '先數有多少筆不同的資料
  20. For j = 1 To myobject(Application.Small(myobject.keys, i))       '先排列,再找出其出現次數
  21. ActiveCell.Value = Application.Small(myobject.keys, i)            
  22. ActiveCell.Offset(1, 0).Value = myobject2(Application.Small(myobject.keys, i) & "," & j)
  23. ActiveCell.Offset(0, 1).Select
  24. Next
  25. Next
  26. End With

  28. Set myobject = Nothing
  29. Set myobject2 = Nothing

  31. End Sub
複製代碼
80 字節以內
不支持自定義 Discuz! 代碼

TOP

FAlonso

帖子
135 
主題
19 
精華
0 
積分
165 
點名
0  
作業系統
XP 
軟體版本
2003 
閱讀權限
20 
性別
男 
來自
香港 
註冊時間
2010-12-9 
最後登錄
2012-8-27 
4#
發表於 2011-1-15 12:45 | 顯示全部帖子
本帖最後由 FAlonso 於 2011-1-15 14:13 編輯

看第20頁,那個是最終程式
80 字節以內
不支持自定義 Discuz! 代碼

TOP

FAlonso

帖子
135 
主題
19 
精華
0 
積分
165 
點名
0  
作業系統
XP 
軟體版本
2003 
閱讀權限
20 
性別
男 
來自
香港 
註冊時間
2010-12-9 
最後登錄
2012-8-27 
5#
發表於 2011-1-15 14:01 | 顯示全部帖子
  1. Sub merge_rank2()
  2. Dim myobject As Object, myobject2 As Object
  3. Dim myrange As Range
  4. Dim i As Integer, j As Integer, k As Integer, myrow As Integer
  5. Dim mykey

  7. Set myobject = CreateObject("scripting.dictionary")
  8. Set myobject2 = CreateObject("scripting.dictionary")

  10. myrow = Sheet4.Range("A65536").End(xlUp).Row

  12. With Sheet4
  13. For Each myrange In .Range(.[a1], .[a1].End(xlToRight))
  14. myobject(myrange.Value) = myobject(myrange.Value) + 1
  15. For j = 2 To myrow
  16. myobject2(myrange.Value & "," & myobject(myrange.Value) & "," & j) = myrange.Offset(j - 1).Value
  17. Next
  18. Next
  19. End With

  21. With Sheet5
  22. .Activate
  23. .Range("a1").Activate
  24. For i = 1 To myobject.Count
  25. For j = 1 To myobject(Application.Small(myobject.keys, i))
  26. ActiveCell.Value = Application.Small(myobject.keys, i)
  27. For k = 2 To myrow
  28. ActiveCell.Offset(k - 1, 0).Value = myobject2(Application.Small(myobject.keys, i) & "," & j & "," & k)
  29. Next
  30. ActiveCell.Offset(0, 1).Select
  31. Next
  32. Next
  33. End With

  35. Set myobject = Nothing
  36. Set myobject2 = Nothing

  38. End Sub
複製代碼
這個是優化程式,第一行重覆也可使用
我到此為止了.....
80 字節以內
不支持自定義 Discuz! 代碼

TOP

        靜思自在 : 欣賞別人就是莊嚴自己。
返回列表 上一主題