Doppelte ausschließen..........

Gast

Hallo zusammen,
wie kann ich bei dem nachfolgenden Makro ausschließen das Zahlen doppel ausgeworfen werden?


Sub LottoZahlenErstellen()
If Sheets("Zettel").Range("E6").Value > 12 Then
MsgBox " Sie müssen erst den Lottozettel zurücksetzen!"
Exit Sub
End If
Sheets("Zettel").Range("C1:O1").ClearContents
With Application
.Calculation = xlManual
.MaxChange = 0.001
End With
Randomize
With Sheets("Zettel")
.Range("C1").Value = Int(49 * Rnd) + 1
.Range("E1").Value = Int(49 * Rnd) + 1
.Range("G1").Value = Int(49 * Rnd) + 1
.Range("I1").Value = Int(49 * Rnd) + 1
.Range("L1").Value = Int(49 * Rnd) + 1
.Range("N1").Value = Int(49 * Rnd) + 1
End With
End Sub

Gruß Gast

AW: Doppelte ausschließen..........

11.02.2006 13:55:47

Peter

Hallo Gast,
so vielleicht:

Public Sub KeineDoppelten()
Dim aZahlen(1 To 6)  As Integer
Dim iZahl            As Integer
Dim iIndx            As Integer
Dim iEinfg           As Integer
Dim aGefu            As Boolean
   iEinfg = 1

   Do
      Randomize
      iZahl = Int(49 * Rnd) + 1
      aGefu = False
      For iIndx = 1 To UBound(aZahlen)
         If aZahlen(iIndx) = iZahl Then
            aGefu = True
            Exit For
         End If
      Next iIndx
      If aGefu = False Then
         aZahlen(iEinfg) = iZahl
         iEinfg = iEinfg + 1
      End If
   Loop Until iEinfg > 6

   MsgBox "die Zahlen: " & aZahlen(1) & ", " & aZahlen(2) & ", " & _
          aZahlen(3) & ", " & aZahlen(4) & ", " & aZahlen(5) & _
          ", " & aZahlen(6)

Viele Grüße Peter
Eine kurze Nachricht, ob es läuft, wäre nett - danke.

AW: Doppelte ausschließen..........

11.02.2006 14:04:28

Gast

Hallo Peter,
auch Dir ein Danke für die Unterstützung..............
Gruß Gast
PS: Peter heißt nicht jeder. Wohl aber jeder Peter. :-)))

AW: Doppelte ausschließen..........

11.02.2006 13:56:59

Reinhard

Hi peter,
du müßtest bei jeder Zahl in einer Schleife nachprüfen ob sie schon "gezogen" wurde, wenn ja "Ziehung" wiedrholen. Da wirds bestimmt im Archiv oder bei Google geben.
Andere Ansatz:

Sub LottoZahlenErstellen()
Dim anz As Byte, n As Byte, Wort As String, pos As Byte
anz = 49
If Sheets("Zettel").Range("E6").Value > 12 Then
MsgBox " Sie müssen erst den Lottozettel zurücksetzen!"
Exit Sub
End If
Sheets("Zettel").Range("C1:O1").ClearContents
With Application
.Calculation = xlManual
.MaxChange = 0.001
End With
Randomize
For n = 1 To anz
Wort = Wort & Right("0" & CStr(n), 2)
Next n
With Sheets("Zettel")
For n = 3 To 11 Step 2
pos = 2 * (Int(anz * Rnd)) + 1
anz = anz - 1
.Cells(1, n) = CInt(Mid(Wort, pos, 2))
Wort = Left(Wort, pos - 1) & Mid(Wort, pos + 2)
Next n
End With
End Sub

Gruß
Reinhard
ps:Das Forum lebt auch von Rückmeldungen.

Erstmal Danke...........

11.02.2006 14:02:03

Gast

Hallo Reinhard,
erstmal Danke für Deine Unterstützung..............
Gruß Gast

AW: Doppelte ausschließen..........

11.02.2006 15:41:06

Josef

Hallo Peter!
Eine Möglichkeit!

' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Private Function RandomNumbers(StartNumber As Long, EndNumber As Long, Count As Integer, Field As Variant)
Dim intIndex As Integer, intCount As Integer
Dim varTemp() As Variant, varT() As Variant

intCount = EndNumber - StartNumber
Redim varTemp(intCount)
If Count > intCount Then Count = intCount
Redim varT(Count)

For intIndex = 0 To intCount
  varTemp(intIndex) = StartNumber + intIndex
Next

Randomize

For intCount = 0 To Count
  intIndex = Int((Rnd * UBound(varTemp)))
  varT(intCount) = varTemp(intIndex)
  varTemp(intIndex) = varTemp(UBound(varTemp))
  If UBound(varTemp) = 0 Then Exit For
  Redim Preserve varTemp(UBound(varTemp) - 1)
Next

Field = varT

End Function

Sub LottoZahlenErstellen()
Dim varNumbers As Variant

If Sheets("Zettel").Range("E6").Value > 12 Then
  MsgBox " Sie müssen erst den Lottozettel zurücksetzen!"
  Exit Sub
End If

Sheets("Zettel").Range("C1:O1").ClearContents

With Application
  .Calculation = xlManual
  .MaxChange = 0.001
End With

RandomNumbers 1, 49, 6, varNumbers

With Sheets("Zettel")
  .Range("C1").Value = varNumbers(0)
  .Range("E1").Value = varNumbers(1)
  .Range("G1").Value = varNumbers(2)
  .Range("I1").Value = varNumbers(3)
  .Range("L1").Value = varNumbers(4)
  .Range("N1").Value = varNumbers(5)
End With

End Sub

'******************************
'* Gruß Sepp
'*
'* Rückmeldung wäre nett!
'******************************

Danke Sepp ......

11.02.2006 18:10:29

Gast

Danke Sepp,
alles Gute Dir, Gast

Doppelte ausschließen..........

Forumthread: Doppelte ausschließen..........

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Doppelte ausschließen..........

Forumthread: Doppelte ausschließen..........

6 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu diesem und ähnlichen Themen

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread