Optimierung der Arbeitsverteilung durch eindimensionalen Bin-Packing-Algorithmus_4.Attachment
Der Quellcode dieses Artikels basiert auf der ersten Version des Bin-Packing-Tools. Es gibt die neueste Version mit verbesserten Funktionen, also beziehen Sie sich bitte gemeinsam darauf.
Letzte Änderungen am eindimensionalen Bin-Packing-Tool (Stand: 21. März 2021)
5. Anhang
5.1. Excel VBA-basierter Tool-Quellcode
Das mit Excel VBA implementierte Bin Packing wird rein mit VBA-Code ohne externe Bibliothek oder Paket implementiert, sodass die Menge an Quellcode ziemlich lang ist. Die meisten Algorithmen sind in der CPacker-Klasse implementiert, werfen Sie also zuerst einen Blick auf diese Klasse.
5.1.1. Tabellenquellcode ausführen
Dieser Code entspricht dem Click-Event der Schaltfläche „Run BinPacking“.
Übergeben Sie mithilfe des Range-Objekts von Excel den Basisbereich und die Optionswerte der Liste an die RunBinPacking-Prozedur. Hier verwendet Range hauptsächlich Entitäten, die durch Namen definiert sind. (Beispiel: Range(“MaxBinSize”)) Wenn Range als Name definiert ist, muss der Quellcode nicht geändert werden, selbst wenn die Referenzadresse geändert wird, und es ist praktisch, da die Referenzadresse automatisch geändert wird, wenn Funktionen wie z Zeileneinfügung und Spalteneinfügung werden ausgeführt.
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. Quellcode des modFactory-Moduls
Es ist für das Erstellen einer Instanz der Klasse verantwortlich. Klassen in VBA können Konstruktoren nicht mit Parametern überschreiben. Anstelle eines Konstruktors wird ein von Factory Pattern implementiertes Modul verwendet.
aPackingType der CreatePacker-Prozedur ist eine Aufzählungsvariable, die den Verarbeitungstyp des Bin-Packing-Algorithmus angibt. Es gibt vier mögliche Werte: ptNextFit, ptFirstFit, ptBestFit und 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. Quellcode des modControl-Moduls
Es ist für die Verwaltung der Verarbeitung des gesamten Algorithmus in der RunBinPacking-Prozedur verantwortlich. Die Bedeutung der einzelnen Parameter ist wie folgt.
- aBaseRange: der Startbereich der Eingabedaten (eine Zeichenfolge wie „B2“)
- aMaxBinSize: beschränkt die maximale Größe eines Bins (eine Ganzzahl wie 80, 10000 usw.)
- aSizeBaseColumn: In der Option ausgewählter Basisspaltenname der Bin-Größe (Zeichenfolge wie „C“)
- aIsItemSort: Ob eine absteigende Sortierung durchgeführt werden soll (True/False-Wert)
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. Quellcode des modUtil-Moduls
Es ist für allgemeine Funktionen wie das Protokollieren und Konvertieren der erforderlichen Zeit in das Zeichenfolgenformat verantwortlich. Die Protokollierung verwendet die 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. Quellcode der CPacker-Klasse
Implementieren Sie einen Bin-Packing-Algorithmus, der die Eingabedaten an einer geeigneten Stelle in der vorhandenen Bin-Liste füllt oder neue Bins erstellt und füllt. Die wichtigsten Variablen, Prozeduren und Funktionen sind wie folgt.
- Die Liste der Bin-Objekte wird als Sammlungsvariable m_oBinCol verwaltet, und die Summe des verbleibenden Speicherplatzes jedes Bin-Objekts wird als lRemainSizeSum-Variable verwaltet.
- Init-Prozedur: Legen Sie die maximale Größe des Behälters und die Art des Füllalgorithmus fest (Next Fit, First Fit, Best Fit, Worst Fit).
Prozedur hinzufügen: Fügt das als Parameter übergebene Bin-Objekt der Sammelvariablen m_oBinCol hinzu und erzeugt den Namen „Bin_order number 5“. - DoPacking-Prozedur: Füllt die Item-Liste, die als Parameter an die Bin-Objektliste übergeben wird.
- GetNewBin-Funktion: Erstellt ein neues Bin-Objekt unter Verwendung der CreateBin-Funktion des modFactory-Moduls.
- GetBinNextFit-Funktion: Wählt einen geeigneten Bin aus, um das als Parameter übergebene BinItem mit dem Next-Fit-Algorithmus zu füllen oder erstellt einen neuen und gibt ihn zurück.
- GetBinFirstFit-Funktion: Wählt einen geeigneten Bin aus, um das als Parameter übergebene BinItem mit dem First-Fit-Algorithmus zu füllen oder erstellt einen neuen und gibt ihn zurück.
- Funktion GetBinWorstFit: Wählt einen geeigneten Bin aus, um das als Parameter übergebene BinItem mit dem Worst-Fit-Algorithmus zu füllen oder erstellt einen neuen und gibt ihn zurück.
- GetBinBestFit-Funktion: Wählt einen geeigneten Bin aus, um das als Parameter übergebene BinItem mit dem Best-Fit-Algorithmus zu füllen oder erstellt einen neuen und gibt ihn zurück.
- PackToBin-Prozedur: Füllt BinItems durch Aufrufen der entsprechenden Funktion gemäß dem eingestellten Algorithmustyp.
- DoOutput-Prozedur: Gibt das Ergebnis der Bin-Packing-Verarbeitung an das angegebene Blatt aus.
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. Quellcode der CBin-Klasse
Implementieren Sie einzelne Behälter.
- Verwalten Sie die in den Behälter gefüllten Artikel mit der Sammlungsvariable m_oBinItemCol.
- Init-Prozedur: Legen Sie die maximale Größe des Behälters fest.
- AddBinItem-Prozedur: Fügt der m_oBinItemCol-Sammlung ein Element im Sinne des Füllens des aktuellen Behälters hinzu. Zu diesem Zeitpunkt wird die Größe des entsprechenden Elements zur Größe des aktuellen Bins hinzugefügt und mit der m_lCurSize-Variablen verwaltet, und die verbleibende Größe nach Subtrahieren der Größe des aktuellen Bins von der maximalen Größe des Bins wird mit m_lRemainSize verwaltet Variable.
- IsAbleToAdd: Bestimmt, ob das als Parameter übergebene BinItem in die aktuelle Bin gefüllt werden kann. True, wenn das Ergebnis der Addition der Größe des Elements zur Größe des aktuellen Behälters kleiner oder gleich der maximalen Größe ist.
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. Quellcode der CBinItemCollection-Klasse
Implementiert eine Liste von BinItems.
- Die Liste der BinItems wird von der Sammlungsvariable m_oBinItemCol verwaltet.
- Prozedur hinzufügen: Fügt das als Parameter empfangene Element zur Sammlung m_oBinItemCol hinzu.
- Sortierfunktion: Gibt eine neue Sammlung zurück, die die m_oBinItemCol-Sammlung in absteigender Reihenfolge der Größe jedes Elements sortiert.
- GetString-Funktion: Gibt das gesamte Element als Zeichenfolge im Format [Name: Größe] zurück.
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. Quellcode der CBinItem-Klasse
Implementieren Sie den Artikel, der in den Papierkorb gelegt werden soll.
- Der Elementname ist m_sName und die Größe wird als m_lSize verwaltet.
- CompareTo-Funktion: Gibt das Ergebnis des Vergleichs der Größe des aktuellen Elements und des zu vergleichenden Elements zurück.
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. Quellcode der CTimer-Klasse
Es wird verwendet, um die Ausführungszeit jedes Algorithmus genau zu messen.
Quelle: https://stackoverflow.com/questions/198409/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
<< Liste verwandter Artikel >>
- Optimierung der Arbeitsverteilung durch eindimensionalen Bin-Packing-Algorithmus_1.Überblick
- Optimierung der Arbeitsverteilung durch eindimensionalen Bin-Packing-Algorithmus_2.Algorithmus (1)
- Optimierung der Arbeitsverteilung mit eindimensionalem Bin-Packing-Algorithmus_2.Algorithmus(2)
- Optimierung der Arbeitsverteilung durch eindimensionalen Bin-Packing-Algorithmus_3.Implementierung (1)
- Optimierung der Arbeitsverteilung durch eindimensionalen Bin-Packing-Algorithmus_3.Implementierung (2)
- Optimierung der Arbeitsverteilung durch eindimensionalen Bin-Packing-Algorithmus_4.Attachment
- Letzte Änderungen am eindimensionalen Bin-Packing-Tool (Stand: 21. März 2021)
- Tool zur Optimierung der Arbeitsverteilung mit eindimensionalem Bin-Packing-Algorithmus Vollständiger Inhalt, Download