Quicksort/Bubblesort. Hilfe bei Algorithmus
27.12.2016 20:28:35
Max2
ich möchte einen Betrag der Per InputBox eingegeben wird auf die drei am meisten vorkommenden Kostenstellen aufteilen.
Das Array lngCount() zählt wie oft eine bestimmte Kostenstelle vorkommt.
Das Array vKostenstelle() wird mit den Vorkommenden Kostenstellen befüllt.
Nun würde ich gerne ein zweidimensionales Array erstellen welches mit den Werten aus lngCount und vKostenstelle befüllt wird.
Die Werte dieses Arrays wollte ich dann per Quicksort oder Bubblesort der größe nach sortieren, so dass ich mir ganz einfach die ersten drei Einträge des neuen Arrays holen kann und den User Wert auf diese Aufteilen kann.
Ich habe allerdings erhebliche Probleme ein Quick- /Bubblesort Algorithmus für ein mehrdimensionales Array zu erstellen.
Könnt ihr mir helfen?
Hier Code:
Option Explicit
Dim i, x
Dim lngCount(), lngZeile As Long
Dim Kostenstelle() As String
Dim arr()
Dim wks As Worksheet
Dim c, rngBereich As Range
Dim vCountKst As Variant
Dim Low, High As Long
Dim vZahl, vTemp As Variant
Dim j As Long
Sub TK_Anschluss()
Application.ScreenUpdating = False
Set wks = ThisWorkbook.Sheets("Daten")
With wks
lngZeile = .Range(.Cells(.Rows.Count, 5), .Cells(2, 5)).Find( _
What:="*", LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:= _
xlByRows, SearchDirection:=xlPrevious).Row
Set rngBereich = .Range(.Cells(2, 5), .Cells(lngZeile, 5))
x = 0
ReDim Preserve lngCount(x)
lngCount(x) = 0
ReDim Preserve Kostenstelle(x)
Kostenstelle(x) = "1004"
For Each c In rngBereich
If c.Value = Kostenstelle(x) Then
lngCount(x) = lngCount(x) + 1
Else
x = x + 1
ReDim Preserve Kostenstelle(x)
ReDim Preserve lngCount(x)
Kostenstelle(x) = c.Value
End If
Next c
Debug.Print LBound(lngCount)
Debug.Print UBound(lngCount)
End With
Application.ScreenUpdating = True
End Sub
Sub QuickSort()
If Low > High Then Exit Sub
vZahl = vCountKst((LBound(lngCount) + UBound(lngCount)) / 2)
i = LBound(lngCount): j = UBound(lngCount)
Do
Do While vCountKst(i) vZahl
j = j - 1
Loop
If i j
If (j - Low)