|
Hallo Leute!!!
Ich bin echt verzweifelt bezüglich einer Aufgabenstellung:
Verwenden Sie den Bublesort-Algorithmus
Erstellen sie in Spalte A 10 zufällige Zahlen (0-100)
Lesen Sie die Werte in ein Datenfeld
Sortieren sie die Zahlen mit dem Algorithmus:??wobei nach jedem Sortierschritt
- Der Algorithmus 1s wartet
- Das Datenfeld in das Excel (Spalte A) kopiert wird
Kennt sich da irgendjemand aus? Mein Vorschlag wäre:
Sub Datenfelder()
Randomize
Dim i As Integer
For i = 0 To 100
Sheets("Tabelle1").Range("A1:A10") = i
Next i
End Sub
Function SortArray(data) As Variant
Dim idx As Integer
Dim lval As Integer
Dim rval As Integer
Dim exchanged As Boolean
Do exchanged = False
Debug.Print "starting at begin of data"
For idx = LBound(data) To (UBound(data) - 1)
lval = data(idx)
rval = data(idx + 1)
Debug.Print "checking idx " & idx & ": " & lval & ", " & rval
If lval > rval Then
data(idx) = rval
data(idx + 1) = lval
exchanged = True
Debug.Print "EXHANGE: idx " & idx & ": " & lval & ", " & rval; ""
End If
Application.Wait (Now + TimeValue("0:00:01"))
MsgBox ("Execution resumed after 1 Second")
Next idx
Loop While exchanged
SortArray = data
End Function
Function IsEqualArray(lval, rval) As Boolean
Dim lvalLBound As Integer
Dim lvalUBound As Integer
Dim rvalLBound As Integer
Dim rvalUBound As Integer
Dim idx As Integer
lvalLBound = LBound(lval)
lvalUBound = UBound(lval)
rvalLBound = LBound(rval)
rvalUBound = UBound(rval)
If (lvalLBound = rvalLBound And lvalUBound = rvalUBound) Then
IsEqualArray = True
For idx = lvalLBound To lvalUBound
If (Not lval(idx) = rval(idx)) Then
Debug.Print "Difference at position (" & idx & "): " & lval(idx) & ", " & rval(idx)
IsEqualArray = False
End If
Next idx
Else: IsEqualArray = False
Debug.Print "The arrays have different bounds: (" & lvalLBound & "-" & lvalUBound & ") (" & rvalLBound & "-" & rvalUBound & ")"
End If
End Function
Danke!!
|