Hi,
hab gerade mein Auslandssemester angetreten und wurde hier ein wenig ins kalte Wasser geschmissen...eine Woche um VBA zu lernen ist nicht gerade viel ;-)
Wir sollen einen Algorithmus implementieren, der das BinPacking Problem löst. Allerdings habe ich schon vor dem Ziel Probleme.
Ich habe 10 Zeilen à 2 Spalten die die Bins (=2dim. Fläche, welche später optimal in ein Rechteck gepackt werden sollen) repräsentieren.
Diese sollen der Größe nach sortiert werden.
Untenstehenden Code habe ich geschrieben, aber er sortiert nicht...
er macht eigentlich alles fehlerfrei, außer sortieren.
ich denke es ist nur ein kleiner Fehler...vermutlich was mit dem Aufruf der Sortierprozedur.
Meine Officeversion ist übrigens 2003, aber ich denke das tut nichts zur Sache.
' Eigenen Datentyp deklarieren, 2D-Fläche mit Eigenschaften Höhe
' und Weite:
Type bin
w As Integer 'weite
h As Integer 'höhe
End Type
Sub bubbleSortTest()
'array deklarieren
Dim binArray(10) As bin
'array füllen, liest die Daten ein (10 zeieln à 2 spalten)
' beginnend bei der aktiven Zelle
For i = 0 To 9
binArray(i).h = ActiveCell.Value
binArray(i).w = ActiveCell.Offset(0, 1)
ActiveCell.Offset(1, 0).Select
Next i
' setzt maus ans ende in die nächste freie zelle
ActiveCell.Offset(1, 0).Select
' gibt feld zur kontrolle aus
For i = 0 To 9
ActiveCell.Offset(i, 0).Value = binArray(i).h
ActiveCell.Offset(i, 1).Value = binArray(i).w
Next i
'setzt maus ans ende, mit einer leerzeile
ActiveCell.Offset(11, 0).Select
'sortiere das Array
bubblesort binArray
'gibt das sortierte Array aus
For i = 0 To 9
With ActiveCell
.Offset(i + 1, 0).Value = binArray(i).h
.Offset(i + 1, 1).Value = binArray(i).w
End With
Next i
End Sub
'
' BubbleSort()
' trie des Arrays avec "BubbleSort"
' Input: Array
'
Sub bubblesort(sArray() As bin)
Dim n As Long ' Feldlänge
Dim changer As Boolean ' Abbruchflag
Dim vDummy As bin ' Dummy
n = UBound(sArray)
' Schleife Läuft über das Array
Do While changer And n >= 0
changer = False
For i = 0 To 9
' sortieren nach h
If sArray(i).h > sArray(i + 1).h Then
vDummy = sArray(i)
sArray(i) = sArray(i + 1)
sArray(i + 1) = vDummy
Else 'bei Gleichheit wird nach w sortiert
If sArray(i).h = sArray(i + 1).h And sArray(i).w _ > sArray(i + 1).w Then
vDummy = sArray(i)
sArray(i) = sArray(i + 1)
sArray(i + 1) = vDummy
End If
End If
Next i
n = n - 1
Loop
End Sub |