1차원 Bin Packing 알고리즘을 활용한 작업 배분 최적화_4.별첨

이 글은 새로운 블로그로 옮겼습니다. 5초후 자동으로 이동합니다.

▶ 새로운 블로그 주소: https://prodskill.com/

▶ 새로운 글 주소: https://prodskill.com/job-scheduling-using-1d-bin-packing-algorithm-6/

이 글의 소스코드는 Bin Packing 도구의 처음 버전 기준으로 작성되어 있다. 기능이 개선된 최신버전이 있으므로 함께 참조하기 바란다.

2021.06.12 - [엑셀&VBA/Tools] - 1차원 Bin Packing 도구 최근 변경 사항 (2021-03-21 기준)

1차원 Bin Packing 도구 최근 변경 사항 (2021-03-21 기준)

---

목차

---

5. 별첨

5.1. 엑셀 VBA 기반 도구 소스 코드

엑셀 VBA로 구현한 Bin Packing은 외부 library 또는 package 없이 순수하게 VBA 코드로만 구현해서, 소스코드의 양이 긴 편이다. 알고리즘의 대부분은 CPacker 클래스에 구현되어 있으므로 이 클래스를 먼저 살펴보기 바란다.

1차원 Bin Packing 알고리즘을 활용한 작업 배분 최적화 소스코드 화면

 

5.1.1. Run sheet 소스 코드

“Run BinPacking” 버튼의 클릭 이벤트에 대응하는 코드이다.

Excel의 Range 개체를 사용하여 목록의 base range와 옵션값들을 RunBinPacking 프로시저에 전달한다. 여기에서 Range는 명칭으로 정의된 개체를 주로 사용하였다. (예: Range(“MaxBinSize”)) Range를 명칭으로 정의하면 참조 주소가 변경되더라도 소스코드를 바꿀 필요가 없고, 특히 행 삽입, 열 삽입 등의 기능이 실행될 때 참조 주소가 자동으로 변경되어 편리하다.

Private Sub cmdRunBinPacking_Click()
    RunBinPacking aBaseRange:=Range("B2").Address, _
                  aMaxBinSize:=Range("MaxBinSize").Value, _
                  aSizeBaseColumn:=Range("SizeBaseClolumn").Value, _
                  aIsItemSort:=Range("ItemSize내림차순정렬여부").Value
End Sub

 

5.1.2. modFactory 모듈 소스 코드

클래스의 instance를 생성하는 역할을 담당한다. VBA의 클래스는 parameter를 가지는 생성자 overriding을 할 수 없다. Factory Pattern으로 구현한 모듈을 생성자 대신에 사용한다.

CreatePacker 프로시저의 aPackingType은 Bin Packing 알고리즘 처리 유형을 나타내는 열거형 변수이다. 가능한 값은 ptNextFit, ptFirstFit, ptBestFit, ptWorstFit 네 가지이다.

Option Explicit

Public Function CreatePacker(aMaxBinSize As Long, aPackingType As PackingType) As CPacker
    Set CreatePacker = New CPacker
    CreatePacker.Init aMaxBinSize, aPackingType
End Function

Public Function CreateBin(aMaxBinSize As Long) As CBin
    Set CreateBin = New CBin
    CreateBin.Init aMaxBinSize
End Function

 

5.1.3. modControl 모듈 소스 코드

RunBinPacking 프로시저에서 전체 알고리즘의 처리 과정을 관리하는 역할을 담당한다. Parameter 각각의 의미는 다음과 같다.

• aBaseRange: 입력자료의 시작 범위(“B2” 등의 문자열)
• aMaxBinSize: 한 Bin의 최대 크기 제약 (80, 10000 등의 정수)
• aSizeBaseColumn: 옵션에서 선택한 Bin 크기 기준 컬럼명(“C” 등의 문자열)
• aIsItemSort: 내림차순정렬을 실행할 지의 여부(True/False 값)

Option Explicit

Public Sub RunBinPacking(aBaseRange As String, aMaxBinSize As Long, _
                         aSizeBaseColumn As String, aIsItemSort As Boolean)
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    Dim oBaseRange As Range, lCurRow As Long, oBinItem As CBinItem
    Dim oInputItemCol As CBinItemCollection: Set oInputItemCol = New CBinItemCollection
    Set oBaseRange = Range(aBaseRange)
    Dim sSizeBaseColumn As String, lSizeColumnOffset As Long
    sSizeBaseColumn = aSizeBaseColumn 'Range("SizeBaseClolumn")
    lSizeColumnOffset = Range(oBaseRange, sSizeBaseColumn & "2").Columns.Count - 1

    'Build up the BinItem List Collection
    lCurRow = 0
    For lCurRow = 0 To oBaseRange.CurrentRegion.Rows.Count
        If Trim(oBaseRange.Offset(lCurRow, 0).Value) = "" Then Exit For
        Set oBinItem = New CBinItem
        oBinItem.m_sName = oBaseRange.Offset(lCurRow, 0).Value  'Item Name
        oBinItem.m_lSize = oBaseRange.Offset(lCurRow, lSizeColumnOffset).Value 'Item Size 기준 컬럼의 값(예: KB, MB 등)
        oInputItemCol.Add oBinItem, oBinItem.m_sName
    Next lCurRow

    'Item Size로 내림차순 정렬 처리
    If aIsItemSort Then
        DoLog "정렬 전 --> " + oInputItemCol.GetString
        Set oInputItemCol = oInputItemCol.Sort
        DoLog "정렬 후 --> " + oInputItemCol.GetString
    End If

    Dim lMaxBinSize As Long
    Dim oPackerNextFit As CPacker, oPackerFirstFit As CPacker
    Dim oPackerWorstFit As CPacker, oPackerBestFit As CPacker
    lMaxBinSize = aMaxBinSize

    'NextFit
    Set oPackerNextFit = CreatePacker(lMaxBinSize, ptNextFit)
    oPackerNextFit.DoPacking oInputItemCol
    oPackerNextFit.DoOutput Worksheets("Next Fit")
    Set oPackerNextFit = Nothing

    'FirstFit
    Set oPackerFirstFit = CreatePacker(lMaxBinSize, ptFirstFit)
    oPackerFirstFit.DoPacking oInputItemCol
    oPackerFirstFit.DoOutput Worksheets("First Fit")
    Set oPackerFirstFit = Nothing

    'WorstFit
    Set oPackerWorstFit = CreatePacker(lMaxBinSize, ptWorstFit)
    oPackerWorstFit.DoPacking oInputItemCol
    oPackerWorstFit.DoOutput Worksheets("Worst Fit")
    Set oPackerWorstFit = Nothing

    'BestFit
    Set oPackerBestFit = CreatePacker(lMaxBinSize, ptBestFit)
    oPackerBestFit.DoPacking oInputItemCol
    oPackerBestFit.DoOutput Worksheets("Best Fit")
    Set oPackerBestFit = Nothing

    Worksheets("Result Summary").Activate
    Worksheets("Result Summary").Range("E1") = lMaxBinSize
    DoEvents

    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
End Sub

 

5.1.4. modUtil 모듈 소스 코드

Logging, 소요시간을 문자열 형식으로 변환하는 등의 공통기능을 담당한다. Logging은 Windows API OutputDebugString을 이용한다.

Option Explicit
#Const DEBUGMODE = 1

#If VBA7 Then 'For 64 Bit Systems
    Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr)
    Private Declare PtrSafe Sub OutputDebugString Lib "kernel32" Alias "OutputDebugStringA" (ByVal lpOutputString As String)
#Else 'For 32 Bit Systems
    Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
    Private Declare Sub OutputDebugString Lib "kernel32" Alias "OutputDebugStringA" (ByVal lpOutputString As String)
#End If

'OutputDebugString API를 이용한 Debug Message 출력
'DebugView등을 이용하여 메시지 View 가능함
Public Sub DoLog(aMsg As String)
    #If DEBUGMODE >= 1 Then
        OutputDebugString "[Bin] " & aMsg
    #End If
End Sub

Function GetTimeString(dTime As Double) As String
  Dim H As Integer, M As Integer, S As Integer, MS As Integer, dMS As Double, sMS As String

  H = Int(dTime / 3600)
  M = Int(dTime / 60) Mod 60
  S = Int(dTime Mod 60)
  dMS = (dTime - Int(dTime))
  'MS = dMS * 10 ^ (Len(CStr(dMS)) - 2)
  sMS = Mid(CStr(dMS), 3, Len(dMS))

GetTimeString = Format(H, "00") & ":" & Format(M, "00") & ":" & Format(S, "00") & "." & sMS

End Function

 

 

5.1.5. CPacker 클래스 소스 코드

입력자료를 기존 Bin 목록 중 적합한 곳에 채우거나 새로운 Bin을 생성하여 채우는 Bin Packing 알고리즘을 구현한다. 주요 변수, 프로시저, 함수는 다음과 같다.

• Bin 개체의 목록을 m_oBinCol collection 변수로 관리하고, 각 Bin 개체의 잔여공간 합계를 lRemainSizeSum 변수로 관리한다.
• Init 프로시저: Bin의 최대 크기와 채우는 알고리즘의 유형(Next Fit, First Fit, Best Fit, Worst Fit)을 설정한다.
  Add 프로시저: parameter로 전달받은 Bin 개체를 m_oBinCol collection 변수에 추가하고 이름을 “Bin_순번5자리”로 생성한다.
• DoPacking 프로시저: parameter로 전달받은 Item목록을 Bin 개체 목록에 채운다.
• GetNewBin 함수: modFactory 모듈의 CrreateBin 함수를 이용하여 새로운 Bin 개체를 생성한다.
• GetBinNextFit 함수: parameter로 전달받은 BinItem을 Next Fit 알고리즘으로 채울 적합한 Bin을 선택하거나 새로 생성하여 반환한다.
• GetBinFirstFit 함수: parameter로 전달받은 BinItem을 First Fit 알고리즘으로 채울 적합한 Bin을 선택하거나 새로 생성하여 반환한다.
• GetBinWorstFit 함수: parameter로 전달받은 BinItem을 Worst Fit 알고리즘으로 채울 적합한 Bin을 선택하거나 새로 생성하여 반환한다.
• GetBinBestFit 함수: parameter로 전달받은 BinItem을 Best Fit 알고리즘으로 채울 적합한 Bin을 선택하거나 새로 생성하여 반환한다.
• PackToBin 프로시저: 설정한 알고리즘의 유형에 따라 적합한 함수를 호출하여 BinItem을 채운다.
• DoOutput 프로시저: Bin Packing 처리 결과를 지정한 sheet에 출력한다.

Option Explicit

Public m_oBinCol As Collection
Public m_dElapsedTime As Double
Public Enum PackingType
    ptNextFit
    ptFirstFit
    ptBestFit
    ptWorstFit
End Enum

Private m_lMaxBinSize As Long
Private m_lLastBinIndex As Long
Private m_PackingType As PackingType
Private m_lCompareCount As Long '비교연산의 횟수 누적
Private m_lRemainSizeSum As Long '잔여공간 합계
Private m_oTimer As CTimer

Private Sub Class_Initialize()
    Set m_oBinCol = New Collection
    Set m_oTimer = New CTimer
    m_lLastBinIndex = 1
    m_lCompareCount = 0
End Sub

Private Sub Class_Terminate()
    Set m_oBinCol = Nothing
    Set m_oTimer = Nothing
End Sub

Public Sub Init(aMaxBinSize As Long, aPackingType As PackingType)
    m_lMaxBinSize = aMaxBinSize
    m_PackingType = aPackingType
End Sub

'입력자료 목록을 입력으로 전체 채우기 실행
Public Sub DoPacking(aInputItemCol As CBinItemCollection)
    Dim oBinItem As CBinItem
    m_oTimer.StartCounter
    For Each oBinItem In aInputItemCol.m_oBinItemCol
        Me.PackToBin oBinItem
    Next
    Me.m_dElapsedTime = m_oTimer.TimeElapsed
End Sub

'한 Item 채우기
Public Sub PackToBin(oBinItem As CBinItem)
    Dim oBin As CBin
    'Select Case ePackingType
    Select Case m_PackingType
        Case ptNextFit
            Set oBin = GetBinNextFit(oBinItem)
        Case ptFirstFit
            Set oBin = GetBinFirstFit(oBinItem)
        Case ptWorstFit
            Set oBin = GetBinWorstFit(oBinItem)
        Case ptBestFit
            Set oBin = GetBinBestFit(oBinItem)
    End Select
    oBin.AddBinItem oBinItem
End Sub


Public Sub Add(oBin As CBin)
    m_oBinCol.Add oBin
    oBin.m_lIndex = m_oBinCol.Count
    'oBin.m_sName = "Bin" + CStr(m_oBinCol.Count)
    oBin.m_sName = "Bin_" + Format(CStr(m_oBinCol.Count), "00000")
End Sub

Public Function GetNewBin() As CBin
    Dim oBin As CBin
    'Set oBin = New CBin
    Set oBin = CreateBin(m_lMaxBinSize)
    Me.Add oBin
    Set GetNewBin = oBin
End Function

'NextFit
Public Function GetBinNextFit(oBinItem As CBinItem) As CBin
    Dim oBin As CBin, oResult As CBin
    If m_oBinCol.Count = 0 Then
        '첫번째 실행인 경우
        Set oResult = GetNewBin
        m_lLastBinIndex = 1
    Else
        Set oBin = m_oBinCol(m_lLastBinIndex)
        m_lCompareCount = m_lCompareCount + 1
        If oBin.IsAbleToAdd(oBinItem) Then
            Set oResult = oBin
        Else
            Set oResult = GetNewBin
            m_lLastBinIndex = oResult.m_lIndex
        End If
    End If
    Set GetBinNextFit = oResult
End Function

'FirstFit
Public Function GetBinFirstFit(oBinItem As CBinItem) As CBin
    Dim oBin As CBin, bFound As Boolean, lCurBinIndex As Long, oResult As CBin
    bFound = False
    '항상 처음 Bin부터 확인하여 추가할 수 있는 Bin return
    For lCurBinIndex = 1 To m_oBinCol.Count
    'For Each oBin In m_oBinCol
        Set oBin = m_oBinCol(lCurBinIndex)
        m_lCompareCount = m_lCompareCount + 1
        If oBin.IsAbleToAdd(oBinItem) Then
            bFound = True
            Set oResult = oBin
            Exit For
        End If
    Next
    If Not bFound Then
        Set oResult = GetNewBin
    End If
    Set GetBinFirstFit = oResult
End Function

'WorstFit
Public Function GetBinWorstFit(oBinItem As CBinItem) As CBin
    Dim oBin As CBin, bFound As Boolean, lCurBinIndex As Long, oResult As CBin
    Dim lMaxRemainSize As Long, lMaxRemainSizeBinIndex As Long
    lMaxRemainSize = 0: lMaxRemainSizeBinIndex = 0
    '모든 Bin중에서 남은 Size가 가장 크고 oBinItem을 추가할 수 있는 Bin을 return
    '추가할 수 있는 Bin이 없으면 새 Bin을 생성
    For lCurBinIndex = 1 To m_oBinCol.Count
        '남은 Size가 가장 큰 Bin 찾기
        Set oBin = m_oBinCol(lCurBinIndex)
        m_lCompareCount = m_lCompareCount + 1
        If lMaxRemainSize < oBin.m_lRemainSize Then
            lMaxRemainSize = oBin.m_lRemainSize
            lMaxRemainSizeBinIndex = lCurBinIndex
        End If
    Next

    bFound = False
    m_lCompareCount = m_lCompareCount + 1
    If lMaxRemainSizeBinIndex > 0 Then
        Set oBin = m_oBinCol(lMaxRemainSizeBinIndex)
        If oBinItem.m_lSize <= oBin.m_lRemainSize Then
            bFound = True
            Set oResult = oBin
        End If
    End If
    If Not bFound Then
        Set oResult = GetNewBin
    End If
    Set GetBinWorstFit = oResult
End Function

'BestFit
Public Function GetBinBestFit(oBinItem As CBinItem) As CBin
    Dim oBin As CBin, bFound As Boolean, lCurBinIndex As Long, oResult As CBin
    Dim lMinRemainSize As Long, lMinRemainSizeBinIndex As Long
    lMinRemainSize = m_lMaxBinSize
    lMinRemainSizeBinIndex = 0
    '모든 Bin중에서 남은 Size가 가장 적으면서 oBinItem을 추가할 수 있는 Bin을 return
    '추가할 수 있는 Bin이 없으면 새 Bin을 생성
    For lCurBinIndex = 1 To m_oBinCol.Count
        'oBinItem을 추가할 수 있는 Bin중 남은 Size가 가장 작은 Bin 찾기
        Set oBin = m_oBinCol(lCurBinIndex)
        m_lCompareCount = m_lCompareCount + 1
        If oBin.m_lRemainSize >= oBinItem.m_lSize And _
           lMinRemainSize > oBin.m_lRemainSize Then
            lMinRemainSize = oBin.m_lRemainSize
            lMinRemainSizeBinIndex = lCurBinIndex
        End If
    Next

    bFound = False
    m_lCompareCount = m_lCompareCount + 1
    If lMinRemainSizeBinIndex > 0 Then
        Set oBin = m_oBinCol(lMinRemainSizeBinIndex)
        bFound = True
        Set oResult = oBin
    End If
    If Not bFound Then
        Set oResult = GetNewBin
    End If
    Set GetBinBestFit = oResult
End Function

'결과 출력
Public Sub DoOutput(oResultSht As Worksheet)
    oResultSht.Activate
    Dim oResultBaseRange As Range, oBin As CBin, lCurRow As Long, oBinItem As CBinItem
    Set oResultBaseRange = oResultSht.Range("A2")
    'oResultBaseRange.End(xlDown).Resize(0, 2).Clear
    oResultBaseRange.Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Resize(, 3).Select
    'Range(Selection, Selection.End(xlToRight)).Select
    Selection.ClearContents
    oResultBaseRange.Select
    lCurRow = 0
    oResultSht.Range("I1") = m_dElapsedTime '소요시간
    oResultSht.Range("J1").NumberFormatLocal = "@"
    oResultSht.Range("J1") = GetTimeString(m_dElapsedTime)
    oResultSht.Range("I2") = m_lCompareCount '비교횟수
    oResultSht.Range("I3") = GetRemainSizeSum '잔여공간합계
    oResultSht.Range("I4") = Me.m_oBinCol.Count * m_lMaxBinSize  '전체공간합계
    For Each oBin In Me.m_oBinCol
        For Each oBinItem In oBin.m_oBinItemCol.m_oBinItemCol
            oResultBaseRange.Offset(lCurRow, 0) = oBin.m_sName
            oResultBaseRange.Offset(lCurRow, 1) = oBinItem.m_sName
            oResultBaseRange.Offset(lCurRow, 2) = oBinItem.m_lSize
            lCurRow = lCurRow + 1
        Next
    Next
    Dim pt As PivotTable, sDataRange As String
    sDataRange = oResultSht.Name + "!R1C1:R" + CStr(oResultBaseRange.CurrentRegion.Rows.Count) + _
                 "C" + CStr(oResultBaseRange.CurrentRegion.Columns.Count)
    For Each pt In oResultSht.PivotTables
        pt.ChangePivotCache ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=sDataRange, Version:=xlPivotTableVersion14)
        pt.RefreshTable
    Next
    oResultBaseRange.Select
End Sub

'잔여공간 합계 계산후 return
Public Function GetRemainSizeSum() As Long
    m_lRemainSizeSum = 0
    Dim oBin As CBin
    For Each oBin In Me.m_oBinCol
        m_lRemainSizeSum = m_lRemainSizeSum + oBin.m_lRemainSize
    Next
    GetRemainSizeSum = m_lRemainSizeSum
End Function

 

5.1.6. CBin 클래스 소스 코드

개별 Bin을 구현한다.

• Bin에 채워진 Item을 m_oBinItemCol collection 변수로 관리한다.
• Init 프로시저: Bin의 최대 크기를 설정한다.
• AddBinItem 프로시저: item을 현재 Bin에 채우는 의미로 m_oBinItemCol collection에 추가한다. 이때, 해당 Item의 크기를 현재 Bin의 크기에 더하여 m_lCurSize 변수로 관리하고, Bin의 최대 크기에서 현재 Bin의 크기를 빼서 남는 크기는 m_lRemainSize 변수로 관리한다.
• IsAbleToAdd: parameter로 전달받은 BinItem을 현재 Bin에 채울 수 있는지를 판별한다. 현재 Bin의 크기에 Item의 크기를 더한 결과가 최대 크기 이하이면 True이다.

Option Explicit

Public m_oBinItemCol As CBinItemCollection
Public m_lIndex As Long
Public m_sName As String
Public m_lCurSize As Long
Public m_lMaxSize As Long
Public m_lRemainSize As Long

Private Sub Class_Initialize()
    Set m_oBinItemCol = New CBinItemCollection
    m_lCurSize = 0
End Sub

Private Sub Class_Terminate()
    Set m_oBinItemCol = Nothing
End Sub

Public Sub Init(lMaxBinSize As Long)
    m_lMaxSize = lMaxBinSize
End Sub

Public Sub AddBinItem(oBinItem As CBinItem)
    m_oBinItemCol.Add oBinItem, oBinItem.m_sName
    m_lCurSize = m_lCurSize + oBinItem.m_lSize
    m_lRemainSize = m_lMaxSize - m_lCurSize
    If m_lRemainSize < 0 Then m_lRemainSize = 0
End Sub

Public Function IsAbleToAdd(oBinItem As CBinItem) As Boolean
    IsAbleToAdd = m_lCurSize + oBinItem.m_lSize <= m_lMaxSize
End Function

 

5.1.7. CBinItemCollection 클래스 소스 코드

BinItem의 목록을 구현한다.

• BinItem의 목록을 m_oBinItemCol collection 변수로 관리한다.
• Add 프로시저: parameter로 전달받은 Item을 m_oBinItemCol collection에 추가한다.
• Sort 함수: m_oBinItemCol collection을 각 Item의 크기 내림차순으로 정렬한 새로운 collection을 반환한다.
• GetString 함수: 전체 Item을 [명칭: 크기]의 형식으로 문자열로 만들어 반환한다.

Option Explicit

Public m_oBinItemCol As Collection

Private Sub Class_Initialize()
    Set m_oBinItemCol = New Collection
End Sub

Private Sub Class_Terminate()
    Set m_oBinItemCol = Nothing
End Sub

Public Sub Add(aBinItem As CBinItem, Optional aKey As String = "")
    m_oBinItemCol.Add aBinItem, IIf(aKey = "", aBinItem.m_sName, aKey)
End Sub

'BinItem의 Size로 내림차순 정렬
Public Function Sort() As CBinItemCollection
    Dim i As Long, j As Long, k As Long, bln As Boolean
    Dim lngCount As Long, arr() As Long, oSortedBinItemCol As CBinItemCollection
    lngCount = m_oBinItemCol.Count
    If lngCount > 0 Then
        ReDim arr(0 To lngCount - 1)
        For i = 0 To lngCount - 1: arr(i) = i + 1: Next

        For i = 1 To lngCount - 1
            k = arr(i)
            j = i - 1
            bln = False
            Do
                If m_oBinItemCol(arr(j)).CompareTo(m_oBinItemCol(k)) > 0 Then
                    arr(j + 1) = arr(j)
                    j = j - 1
                    If j < 0 Then bln = True
                Else
                    bln = True
                End If
            Loop Until bln
            arr(j + 1) = k
        Next
    End If

    Set oSortedBinItemCol = New CBinItemCollection
    For i = lngCount - 1 To 0 Step -1: oSortedBinItemCol.Add m_oBinItemCol(arr(i)): Next

    Set Sort = oSortedBinItemCol
End Function

'BinItem 목록을 문자열로 반환
Public Function GetString() As String
    Dim sResult As String, oBinItem As CBinItem
    For Each oBinItem In m_oBinItemCol
        sResult = sResult + "[" + oBinItem.m_sName + ":" + CStr(oBinItem.m_lSize) + "], "
    Next
    If Len(sResult) > 2 Then sResult = Left(sResult, Len(sResult) - 2)
    GetString = sResult
End Function

 

5.1.8. CBinItem 클래스 소스 코드

Bin에 담길 Item을 구현한다.

• Item의 이름은 m_sName, 크기는 m_lSize로 관리한다.
• CompareTo 함수: 현재 Item과 비교대상 Item의 크기를 비교한 결과를 반환한다.

Option Explicit

Public m_sName  As String
Public m_lSize  As Long

'BinItem의 size 비교 함수
'   - parameter: 비교대상 BinItem(B)
'   - 비교기준: 자기자신 BinItem(A)
'Return 값(Long type)
'  0: 동일함 (A = B)
'  1: 비교대상 BinItem이 더 큼(A < B)
' -1: 자기자신 BinItem이 더 큼(A > B)
Public Function CompareTo(oBinItem As CBinItem) As Long
    Dim i As Long
 
    If Me.m_lSize = oBinItem.m_lSize Then
        i = 0
    ElseIf Me.m_lSize < oBinItem.m_lSize Then
        i = -1
    Else
        i = 1
    End If
 
    CompareTo = i
End Function

 

5.1.9. CTimer 클래스 소스 코드

 각 알고리즘의 실행시간을 정확하게 측정하기 위해 사용한다.

출처: https://stackoverflow.com/questions/198409/how-do-you-test-running-time-of-vba-code

How do you test running time of VBA code?

Option Explicit

Private Type LARGE_INTEGER
    lowpart As Long
    highpart As Long
End Type

Private Declare Function QueryPerformanceCounter Lib "kernel32" (lpPerformanceCount As LARGE_INTEGER) As Long
Private Declare Function QueryPerformanceFrequency Lib "kernel32" (lpFrequency As LARGE_INTEGER) As Long

Private m_CounterStart As LARGE_INTEGER
Private m_CounterEnd As LARGE_INTEGER
Private m_crFrequency As Double

Private Const TWO_32 = 4294967296# ' = 256# * 256# * 256# * 256#

Private Function LI2Double(LI As LARGE_INTEGER) As Double
    Dim Low As Double
    Low = LI.lowpart
    If Low < 0 Then
        Low = Low + TWO_32
    End If
    LI2Double = LI.highpart * TWO_32 + Low
End Function

Private Sub Class_Initialize()
    Dim PerfFrequency As LARGE_INTEGER
    QueryPerformanceFrequency PerfFrequency
    m_crFrequency = LI2Double(PerfFrequency)
End Sub

Public Sub StartCounter()
    QueryPerformanceCounter m_CounterStart
End Sub

Property Get TimeElapsed() As Double
    Dim crStart As Double
    Dim crStop As Double
    QueryPerformanceCounter m_CounterEnd
    crStart = LI2Double(m_CounterStart)
    crStop = LI2Double(m_CounterEnd)
    'TimeElapsed = 1000# * (crStop - crStart) / m_crFrequency
    TimeElapsed = Round((crStop - crStart) / m_crFrequency, 4)
End Property