Lotto: sorteren

• Dit is een module die toelaat om een array te sorteren
  'Om te sorteren moeten we:
  '- de kleinste uit een array halen
  '- de grootste uit een array halen
  '- weten op welke plaats die kleinste staat
  'Belangrijke beperking in VB: een array kan niet worden teruggegeven door een functie
  Function min(ParamArray reeks()) As Variant
  'eerste variant: de reeks doorgeven
  'geeft de laagste uit een reeks
  Dim buffer As Variant
  buffer = reeks(0)
  Dim t As Integer
  For t = 0 To UBound(reeks)
  If reeks(t) < buffer Then buffer = reeks(t)
  Next t
  min = buffer
  End Function
  Private Function minint(rij() As Integer) As Integer
  'tweede variant: de reeks doorgeven als array
  Dim start As Integer
  Dim einde As Integer
  Dim i As Integer
  Dim j As Integer
  Dim hulp As Integer
  
  start = LBound(rij)
  einde = UBound(rij)
  
  For i = start To einde - 1
  If rij(i) < minint Then minint = rij(i)
  Next i
  End Function
  Function max(ParamArray reeks()) As Variant
  'eerste variant: de reeks doorgeven
  'geeft de hoogste uit een reeks
  Dim buffer As Variant
  buffer = reeks(0)
  Dim t As Integer
  For t = 0 To UBound(reeks)
  If reeks(t) > buffer Then buffer = reeks(t)
  Next t
  max = buffer
  End Function
  Private Function maxint(rij() As Integer) As Integer
  'tweede variant: de reeks doorgeven als array
  Dim start As Integer
  Dim einde As Integer
  Dim i As Integer
  Dim j As Integer
  Dim hulp As Integer
  
  start = LBound(rij)
  einde = UBound(rij)
  
  For i = start To einde - 1
  If rij(i) > maxint Then maxint = rij(i)
  Next i
  End Function
  
  Function minpos(ParamArray mreeks()) As Integer
  'geeft de positie van de laagste
  Dim buffer As Variant
  buffer = mreeks(0)
  Dim t As Integer
  For t = 0 To UBound(mreeks)
  If mreeks(t) = min(mreeks()) Then
  minpos = t
  Exit For
  End If
  Next t
  End Function
  'En nu kunnen we:
  '- een nieuwe array opbouwen op basis van de te sorteren array
  '- telkens het minimum vragen en opslaan in het volgende element van de gesorteerde array
  '- het element op de plaats van dat minimum (MINPOS) vervangen door het maximum of een getal groter dan het maximum
  'tot de hele array is doorlopen
  '====================
  Sub testsortint()
  'test SORTINT
  Dim t As Integer
  Dim er(5) As Integer
  er(0) = 3
  er(1) = 7
  er(2) = 9
  er(3) = 1
  er(4) = 8
  er(5) = 2
  sortint er()
  MsgBox minint(er())
  MsgBox maxint(er())
  Dim msg As String
  For t = 0 To 5
  msg = msg & " " & er(t)
  Next t
  MsgBox msg
  End Sub
  Sub testsortvar()
  'test SORTVAR
  sortvar 3, 7, 9, 1, 8, 2
  End Sub
  Sub sortvar(ParamArray reeks() As Variant)
  'eerste variant: de reeks doorgeven als een reeks getallen
  Dim s As Integer
  Dim t As Integer
  Dim u As Integer
  Dim buffer As Variant
  For s = LBound(reeks) To UBound(reeks)
  For t = s + 1 To UBound(reeks)
  If reeks(t) < reeks(s) Then 'switch reeks(s), reeks(t)
  buffer = reeks(t)
  reeks(t) = reeks(s)
  reeks(s) = buffer
  End If
  Next t
  Next s
  For u = LBound(reeks) To UBound(reeks)
  msg = msg & " " & reeks(u)
  Next u
  MsgBox msg
  End Sub
  Private Sub sortint(rij() As Integer)
  'tweede variant: de reeks doorgeven als array
  Dim start As Integer
  Dim einde As Integer
  Dim i As Integer
  Dim j As Integer
  Dim hulp As Integer
  
  start = LBound(rij)
  einde = UBound(rij)
  
  For i = start To einde - 1
  For j = start To einde - 1 - (i - start)
  If rij(j) > rij(j + 1) Then
  hulp = rij(j)
  rij(j) = rij(j + 1)
  rij(j + 1) = hulp
  End If
  Next j
  Next i
  End Sub
  Sub switch(v1 As Variant, v2 As Variant)
  'een hulpje: twee varianten switchen
  Dim v As Variant
  v = v1
  v1 = v2
  v2 = v
  End Sub
  Sub testswitch()
  'SWITCH testen
  Dim x As Integer
  Dim y As Integer
  Dim msg As String
  x = 5
  y = 6
  msg = "voor switch: x = " & x & " en y = " & y
  switch x, y
  msg = msg & vbCrLf & "na switch: x = " & x & " en y = " & y
  MsgBox msg
  End Sub

[VB Web] - [hlrnet] - [copyright]