彰化一整天的論壇

 找回密碼
 立即註冊
查看: 127|回復: 3

將資料讀進字典、排序、轉置

[複製鏈接]
發表於 2021-3-15 20:20:59 | 顯示全部樓層 |閱讀模式
excel20210315.jpg

  1. Option Explicit

  2. Private Sub CommandButton1_Click()
  3.     Dim r As Range
  4.    
  5.     Dim data As Range
  6.    
  7.     Dim i As Integer
  8.    
  9.     Set data = Range("A1:B3")
  10.    
  11.     '設定引用 Microsoft Scripting Runtime才可以使用
  12.     'Tools > References in the Visual Basic Editor (Alt+F11)

  13.     '宣告一個物件變數
  14.     Dim Dict As Scripting.Dictionary
  15.    
  16.     '建立物件實體並指定變數(set)
  17.     Set Dict = New Dictionary
  18.    
  19.     For Each r In data '利用字典不能有重複值的特色來去除重複
  20.         Dict(r.Value) = 0
  21.     Next
  22.    
  23.     Dim arr() As Variant
  24.         'Allocate storage space for the dynamic array
  25.     ReDim arr(0 To Dict.Count - 1)
  26.    
  27.     'Fill the array with the keys from the Dictionary
  28.     For i = 0 To Dict.Count - 1
  29.         arr(i) = Dict.Keys(i)
  30.     Next i
  31.    
  32.     arr = bubble_sort(arr)
  33.    
  34.     For i = 0 To UBound(arr)
  35.         Cells(1, i + 5).Value = arr(i)
  36.     Next
  37.    
  38. End Sub

  39. Function bubble_sort(arr)
  40.     '泡沬排序
  41.     Dim i As Integer
  42.    
  43.     Dim j As Integer
  44.    
  45.     Dim temp As Variant

  46.     'Sort the array using the bubble sort method
  47.     For i = LBound(arr) To UBound(arr) - 1
  48.         For j = i + 1 To UBound(arr)
  49.             If arr(i) > arr(j) Then
  50.                 temp = arr(j)
  51.                 arr(j) = arr(i)
  52.                 arr(i) = temp
  53.             End If
  54.         Next j
  55.     Next i
  56.    
  57.     bubble_sort = arr
  58. End Function
複製代碼



將資料讀進字典、排序、轉置.xlsm

21.85 KB, 下載次數: 1

售價: 1 金錢  [記錄]

回復

使用道具 舉報

發表於 2021-3-30 14:15:23 | 顯示全部樓層
  1. Sub T()
  2. arr = Range("A1:B3")
  3. Set d = CreateObject("scripting.dictionary")
  4. For Each i In arr
  5.         d(i) = i
  6. Next
  7. Range("E10").Resize(1, d.Count) = Application.Transpose(WorksheetFunction.Sort(Application.Transpose(d.Items)))

  8. End Sub
複製代碼
老師,氣泡排序跟內建的排序有什麼不一樣的地方嗎?像我這樣排出來的結果好像也是可以
回復 支持 反對

使用道具 舉報

 樓主| 發表於 2021-3-30 19:40:13 | 顯示全部樓層
yws0915 發表於 2021-3-30 14:15
老師,氣泡排序跟內建的排序有什麼不一樣的地方嗎?像我這樣排出來的結果好像也是可以
...

沒有差,只是您用的轉置及排序在比較早期的excel並沒有提供,若是新的版本用您的寫法是比較簡單。
回復 支持 反對

使用道具 舉報

發表於 2021-3-31 09:12:55 | 顯示全部樓層
原來如此丫,謝謝囉
回復 支持 反對

使用道具 舉報

您需要登錄後才可以回帖 登錄 | 立即註冊

本版積分規則

 ㄚ母滴雞湯
 員林香純滴雞精

Archiver|手機版|小黑屋|彰化一整天的論壇(Excel,Office)

GMT+8, 2021-4-11 02:53 , Processed in 0.110466 second(s), 20 queries .

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

快速回復 返回頂部 返回列表