정렬 알고리즘(엑셀)

본 내용들은 이한출판사 알고리즘(조유근/홍영식/이자수/김명 지음) 책 2장 정렬에 나오는 c언어 소스를 제 방식대로 해석하여 엑셀 VBA에 맞게 변환하였습니다. 본 내용이 책에서 설명하는 내용에 부합하는 지는 여러 분이 판단하시기 바랍니다. 

 [ 파일 ] 

정렬161109.xlsm

[수정] 퀵정렬의 내용에서 불필요한 내용과 대체적으로 C 소스와 유사하게 수정, 정리하였습니다.

[수정] 합병정렬에서 분할부분 출력하도록 수정, 수정된 구문은 파일에서 확인하시기 바랍니다.

 

[추가] 합병정렬(Merge Sort)

[추가] 히프정렬(Heap Sort)--------16-11-20

[비고] 불필요한 구문은 여러 분이 수정하여 사용하십시요. 그리고 제가 사용한 구문이 정답은 아닙니다.  좀더 간편하게 정리할 수 있다면 정리하여 사용하십시요.

 

[ 버블쇼트 Bubble Sort ]

Dim p As Worksheet
Dim a() As Double, b As Double
Dim i As Long, k As Long, m As Long
Dim s As Boolean


    Set p = Worksheets("short")
   
    '기초 데이터수를 구한다.
    '5행에서 빈셀이 아닌 셀의 수를 구하고 데이터가 아닌 셀의 수를 뺀다.
    i = Application.WorksheetFunction.CountA(p.Rows(5)) - 1
   
    ReDim a(i) '배열 재선언
   
    '배열에 데이터 입력
    For k = 0 To (i - 1)
       
        a(k) = p.Cells(5, k + 3)
       
    Next k
   
   
    For k = 1 To i
       
       
        s = False
       
        For m = 0 To (i - 2)
           
            'm과 m+1의 데이터를 비교하여 m+1이 크면 교환
            If (a(m) > a(m + 1)) Then
               
                b = a(m)
                a(m) = a(m + 1)
                a(m + 1) = b
                s = True
               
            End If
               
        Next m
       
       
       
       
        '정렬의 필요성 검토
        If s = False Then
           
            Exit For
           
        Else
                  
            '단계출력
            p.Cells(7 + k, 2) = k
       
            '데이터 출력
            For m = 0 To (i - 1)
               
                p.Cells(7 + k, 3 + m) = a(m)
           
            Next m
           
        End If
       
    Next k
   

[ 삽입정렬 Insertion Sort]

Dim p As Worksheet
Dim a() As Double, b As Double
Dim i As Long, k As Long, m As Long
Dim s As Boolean


    Set p = Worksheets("short")
   
    '기초 데이터수를 구한다.
    '5행에서 빈셀이 아닌 셀의 수를 구하고 데이터가 아닌 셀의 수를 뺀다.
    m = Application.WorksheetFunction.CountA(p.Rows(5)) - 1
   
    ReDim a(m) '배열 재선언
   
    '배열에 데이터 입력
    For k = 0 To (m - 1)
       
        a(k) = p.Cells(5, k + 3)
       
    Next k
   
    For i = 1 To (m - 1)
       
        p.Cells(7 + i, 2) = i
       
        For j = 0 To (i - 1)
       
            If (a(j) > a(i)) Then
               
                b = a(i)
                a(i) = a(j)
                a(j) = b
                           
            End If
       
        Next j
       
        For j = 0 To (m - 1)
           
            p.Cells(7 + i, 3 + j) = a(j)
       
        Next j
       
    Next i

[ 퀵정렬 Qucik Sort]

청색 : pivot, 적색 : 교환 대상

Type 퀵요소

    

    point As Long

    

End Type

Public qe As 퀵요소

Sub quick_sort()

Dim p As Worksheet

Dim m As Long, k As Long

Dim left As Long, right As Long

Dim ay() As Double

    

    Set p = Worksheets("sort")

    

    '기초 데이터수를 구한다.

    '5행에서 빈셀이 아닌 셀의 수를 구하고 데이터가 아닌 셀의 수를 뺀다.

    m = Application.WorksheetFunction.CountA(p.Rows(5)) - 1

    

    '초기화

    p.Range(Cells(8, 2), Cells(1000, 255)).Clear

    

    ReDim ay(m + 1)

    

    For k = 0 To (m - 1)

        

        ay(k) = p.Cells(5, k + 3)

    

    Next k

     

    '더미 추가

    '더미값은 배열의 최대값보다 크게 입력한다.

    ay(m) = Application.WorksheetFunction.Max(ay()) + 10

    

    left = 0

    right = m

    

    '인쇄위치 초기값 설정

    qe.point = 8

    

    Call 순환(ay(), left, right)

    

    

End Sub

Sub 순환(ay() As Double, i As Long, j As Long)

Dim middle As Long

    'i=left, j right

    

    If (j > i) Then

        

        middle = 분할(ay(), i, j + 1)

        

        Call 출력(ay())

                

        Call 순환(ay(), i, middle - 1)

        

        Call 순환(ay(), middle + 1, j)

        

        

    End If

        

    

    

End Sub

Function 분할(ay() As Double, i As Long, j As Long) As Long

Dim partelem As Long, pivort As Long

Dim a As Double

    pivot = ay(i)

    partelem = i

    

    Do

            

        Do

            

            i = i + 1

            

        Loop While (ay(i) < pivot)

        

            

        Do

                

            j = j - 1

            

        Loop While (ay(j) > pivot)

        

        If (i < j) Then

            

            a = ay(i)

            ay(i) = ay(j)

            ay(j) = a

            

            Call 확인(partelem)

            Call 번호확인(i, j)

            Call 출력(ay())

    

        Else

            

           

            Exit Do

            

        End If

           

           

    Loop

    

    

    ay(partelem) = ay(j)

    ay(j) = pivot

    

    분할 = j

    i = partelem

    

    Call 확인(j)

            

        

End Function

Sub 확인(i As Long)

    

    With Worksheets("sort").Cells(qe.point, i + 3).Font

    

        .Bold = True

        .Color = RGB(100, 100, 200)

        .Size = 13

        

    End With

        

End Sub

Sub 번호확인(i As Long, j As Long)

    

    With Worksheets("sort")

        

        'left

        .Cells(qe.point, i + 3).Font.Bold = True

        .Cells(qe.point, i + 3).Font.Color = RGB(255, 0, 0)

        .Cells(qe.point, i + 3).Font.Size = 13

        

        'right

        .Cells(qe.point, j + 3).Font.Bold = True

        .Cells(qe.point, j + 3).Font.Color = RGB(255, 0, 0)

        .Cells(qe.point, j + 3).Font.Size = 13

        

    End With

        

End Sub

Sub 출력(ay() As Double)

Dim k As Long, m As Long

    With Worksheets("sort")

        

        m = Application.WorksheetFunction.CountA(.Rows(5)) - 2

        

        .Cells(qe.point, 2) = qe.point - 7

        

        For k = 0 To m

            

            .Cells(qe.point, k + 3) = ay(k)

            

        Next k

        

        qe.point = qe.point + 1

        

    End With

End Sub

[ 합병정렬 Merge Sort]

Private point As Long

Private merge_step As Long

Private merge_size As Long

Sub merge_준비()

Dim p As Worksheet

Dim m As Long, k As Long

Dim low As Long, high As Long

Dim ms() As Double

    

    Set p = Worksheets("sort")

    

    '기초 데이터수를 구한다.

    '5행에서 빈셀이 아닌 셀의 수를 구하고 데이터가 아닌 셀의 수를 뺀다.

    merge_size = Application.WorksheetFunction.CountA(p.Rows(5)) - 1

    

    '초기화

    p.Range(Cells(8, 2), Cells(1000, 255)).Clear

    

    '배열크기 재정의

    ReDim ms(merge_size)

    

    '시트에 있는 데이터를 부러와 배열에 입력

    For k = 0 To (merge_size - 1)

        

        ms(k) = p.Cells(5, k + 3)

    

    Next k

     

    low = 0

    high = (merge_size - 1)

    

    '인쇄위치 초기값 설정

    point = 8

    merge_step = 1

    

    Call MergeSort(ms(), low, high)

    

End Sub

Sub MergeSort(ms() As Double, low As Long, high As Long)

Dim mid As Long

    If (low < high) Then

        

        mid = Application.WorksheetFunction.RoundDown((low + high) / 2, 0)

        

        Call MergeSort(ms(), low, mid)

        Call MergeSort(ms(), mid + 1, high)

        Call Merge(ms(), low, mid, high)

        

        

    End If

    

End Sub

Sub Merge(ms() As Double, low As Long, mid As Long, high As Long)

Dim b() As Double

Dim i As Long, leftptr As Long, rightptr As Long, bufptr As Long

    ReDim b(merge_size)

    

    leftptr = low

    bufptr = low

    rightptr = mid + 1

    

    Call prt(ms(), low, mid, high)

    

    Do While (leftptr <= mid) And (rightptr <= high)

        

        If (ms(leftptr) <= ms(rightptr)) Then

            

            b(bufptr) = ms(leftptr)

            leftptr = leftptr + 1

            

        Else

            

            b(bufptr) = ms(rightptr)

            rightptr = rightptr + 1

            

        End If

        

        bufptr = bufptr + 1

            

        

        

    Loop

     

    If (leftptr > mid) Then

        

        For i = rightptr To high

                

            b(bufptr) = ms(i)

            bufptr = bufptr + 1

          

        Next i

            

    Else

        

        For i = leftptr To mid

                

            b(bufptr) = ms(i)

            bufptr = bufptr + 1

       

        Next i

        

    End If

        

    Call prt01(b(), low, high)

        

    For i = low To high

        

        ms(i) = b(i)

               

    Next i

        

        

 

    

End Sub

Sub prt(ms() As Double, low As Long, mid As Long, high As Long)

Dim k As Long, m As Long

    With Worksheets("sort")

        

        .Cells(point, 2) = merge_step

        

        With .Rows(point).Font

                .Bold = True

                .Color = RGB(100, 100, 200)

                .Size = 13

        End With

        

        Call 블록(low, mid)

        

        Call 블록(mid + 2, high + 1)

        

        For k = low To high

            

            If (k <= mid) Then

                

                .Cells(point, k + 3) = ms(k)

             

            Else

                

                .Cells(point, k + 4) = ms(k)

            

            End If

            

        Next k

        

        point = point + 2

        merge_step = merge_step + 1

        

    End With

End Sub

Sub prt01(ms() As Double, low As Long, high As Long)

Dim k As Long, m As Long

    With Worksheets("sort")

        

        With .Rows(point).Font

                .Bold = True

                .Color = RGB(255, 0, 0)

                .Size = 13

        End With

        

        Call 블록(low, high)

        

        .Cells(point, 2) = merge_step

        

        For k = low To high

            

            .Cells(point, k + 3) = ms(k)

            

        Next k

        

        point = point + 2

        merge_step = merge_step + 1

        

    End With

End Sub

Sub 블록(i As Long, j As Long)

    

Range(Cells(point, i + 3), Cells(point, j + 3)).BorderAround LineStyle:=xlContinuous, ColorIndex:=0, Weight:=xlMedium

    

End Sub

[ 히프정렬 Heap Sort]

Private point As Long

Private heap_step As Long

Sub heap_준비()

Dim p As Worksheet

Dim k As Long, m As Long

Dim heap_array() As Double

    

    Set p = Worksheets("sort")

    

    '기초 데이터수를 구한다.

    '5행에서 빈셀이 아닌 셀의 수를 구하고 데이터가 아닌 셀의 수를 뺀다.

    m = Application.WorksheetFunction.CountA(p.Rows(5)) - 1

    

    '초기화

    p.Range(Cells(8, 2), Cells(1000, 255)).Clear

    

    '배열크기 재정의

    ReDim heap_array(m)

    

    '시트에 있는 데이터를 부러와 배열에 입력

    For k = 0 To (m - 1)

        

        heap_array(k) = p.Cells(5, k + 3)

    

    Next k

    

    '인쇄위치 초기값 설정

    point = 8

    

    heap_step = 1

    

    Call Heapsort(heap_array(), m)

    

End Sub

Sub Heapsort(heap_array() As Double, m As Long)

Dim i As Long, j As Long, k As Long, n As Long

Dim a As Double

    n = m - 1

    

    i = Int(m / 2)

    

    '1차원 배열을 히프로 변환

    For k = 0 To (i - 1)

    

        j = i - k

        

        Call MakeHeap(heap_array(), j - 1, n)

        

        Call prt02(heap_array(), n, False)

        

    Next k

     

    '히프에서 최대값을 제거하고 남아있는 원소들만으로 다시 히프 구성

    For k = 0 To (n - 1)

    

        j = n - k

        

        '배열의 최대값을 j열로 보낸다.

        a = heap_array(0)

        heap_array(0) = heap_array(j)

        heap_array(j) = a

        

        '0에서 j-1에 대한 히프를 재구성한다.

        

        Call 블록(0, j - 1) ' 재구성된 히프 표시

        

        Call MakeHeap(heap_array(), 0, j - 1)

        

        Call prt02(heap_array(), n, True)

    

    Next k

    

End Sub

Sub MakeHeap(heap_array() As Double, Root As Long, LastNode As Long)

Dim Parent As Long, LeftSon As Long, RightSon As Long, Son As Long, RootValue As Long

    Parent = Root

    RootValue = heap_array(Root)

    LeftSon = 2 * Parent + 1

    RightSon = LeftSon + 1

    

    Do While (LeftSon <= LastNode)

    

        If (RightSon <= LastNode) And (heap_array(LeftSon) < heap_array(RightSon)) Then

            

            Son = RightSon

        

        Else

            

            Son = LeftSon

        

        End If

        

        If (RootValue < heap_array(Son)) Then

            

            heap_array(Parent) = heap_array(Son)

            Parent = Son

            LeftSon = Parent * 2 + 1

            RightSon = LeftSon + 1

            

        Else

            

            Exit Do

        

        End If

        

    Loop

    heap_array(Parent) = RootValue

    

End Sub

Sub prt02(heap_array() As Double, LastNode As Long, sel As Boolean)

Dim k As Long, m As Long

    With Worksheets("sort")

        

        With .Rows(point).Font

                .Bold = True

                

                If (sel) Then

                    .Color = RGB(255, 0, 0)

                Else

                    .Color = RGB(100, 100, 200)

                End If

                

                .Size = 13

        End With

        

        .Cells(point, 2) = heap_step

        

        For k = 0 To LastNode

            

            .Cells(point, k + 3) = heap_array(k)

            

        Next k

        

        point = point + 2

        heap_step = heap_step + 1

        

    End With

End Sub

Sub 블록(i As Long, j As Long)

    

    b = Array(xlEdgeLeft, xlEdgeTop, xlEdgeBottom, xlEdgeRight)

    

    Range(Cells(point, i + 3), Cells(point, j + 3)).BorderAround LineStyle:=xlContinuous, ColorIndex:=0, Weight:=xlMedium

    

    

End Sub

정렬161109.xlsm

0.09MB