엑셀 VBA #49 / New Collection_버블정렬의 콜라보 [VBA]

엑셀 VBA #49 / New Collection_버블정렬의 콜라보 [VBA]

Dim nc As New Collection
Dim rng As Range, c As Range
Dim a() As Variant
Dim i As Long

Set rng = Range("A1", Cells(Rows.Count, "A").End(xlUp))

'----------------------------
'고유목록 추출
'----------------------------
On Error Resume Next
For Each c In rng
    If Len(c) Then
        nc.Add Trim(c), CStr(Trim(c))
    End If
Next
On Error GoTo 0

'---------------------------
'배열에 넣기(dc에서 저장하고 있는 고유목록을 동적배열a에 넣기)
'---------------------------
ReDim a(nc.Count - 1)

For i = 0 To nc.Count - 1
    a(i) = nc(i + 1)
Next

 

 

 

 

'---------------------------
'동적배열a에 있는 값을 뿌리기
'---------------------------
Range("C1").Resize(1, UBound(a) + 1) = a
Range("B1").Resize(UBound(a) + 1, 1) = Application.Transpose(a)

결과값

위 결과값 그림상의 고유항목들이 오름 or 내림차순 정렬이 아니다.
이를 오름차순 정렬한 코드는 다음과 같다.
Dim nc As New Collection
Dim rng As Range, c As Range
Dim a() As Variant
Dim i As Long, j As Long
Dim temp As Variant

.................
'---------------------------
'배열에 넣기(dc에서 저장하고 있는 고유목록을 동적배열a에 넣기)
'---------------------------
ReDim a(nc.Count - 1)
For i = 0 To nc.Count - 1
    a(i) = nc(i + 1)
Next

'---------------------------
'정렬(버블정렬)
'---------------------------
For i = 0 To dc.Count - 2
    For j = i + 1 To dc.Count - 1
        If a(i) > a(j) Then
            temp = a(i)
            a(i) = a(j)
            a(j) = temp
        End If
    Next
Next
'---------------------------
'동적배열a에 있는 값을 뿌리기
'---------------------------
Range("C1").Resize(1, UBound(a) + 1) = a
Range("B1").Resize(UBound(a) + 1, 1) = Application.Transpose(a)

고유항목이 정렬되어 뿌려진 결과값

vba#49.xlsm

0.02MB

https://www.youtube.com/watch?v=uuyRUNZC2GE&list=PLfxvqpVCYZ8e0qlyc_FU46neoWjO7yTWj&index=49