Makro für Zufallszahlen

Hallo,
bin neu hier und hab kaum Kenntnisse und suche deshalb Hilfe für folgende Aufgabenstellung.

In einer Spalte stehen von F70 bis F118 Zahlen. Aus dieser Spalte sollen 6 Zahlen per Zufall ermittelt werden, aus 6 definierten Bereichen:
F70 - F74, F75 - F80, F81 - F90, F70 - F90, F91 - F100, F95 - F106

Da sich die Bereich teilweise überschneiden, ist es möglich, daß Zahlen doppelt vorkommen. Das soll natürlich vermieden werden.
Die sechs Zahlen sollen abschließend auch in aufsteigender Reihenfolge erscheinen.

Ich kriege das zwar hin mit dem Befehl =INDIREKT("F"&ZUFALLSBEREICH(70;74)) als Beispiel für die erste Zahl, aber nur in einem Excel-Tabellenblatt.

Das ganze soll aber per Makro funktionieren, indem man auf einen Button klickt.

Im Makro funktioniert der Befehl aber nicht. Offenbar kann Visual Basic den Befehl ZUFALLSBEREICH nicht interpretieren.

Die 6 Zufallszahlen sollen in die Felder "Berechnungen!E13" , "Berechnungen!F13" bis "Berechnungen!J13" geschrieben werden.

Wie man das Makro auf eine Grafik legt, weiß ich.

Wie gesagt, ich habe keine großen Programmierkenntnisse und muß mir alles mühsam beibringen. Über HIlfe wäre ich sehr dankbar.

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender


Option Explicit

'F70 - F74, F75 - F80, F81 - F90, F70 - F90, F91 - F100, F95 - F106
'Hierfür Indizes
Public Type tpGruppen
    lng_01Unten As Long
    lng_02Oben As Long
End Type

'Index beginnt bei 0=>6 Gruppen
Public arrGruppen(5) As tpGruppen

'Zahlen
Public arrZahlen(5) As Double
Public intIndex As Integer

Public Sub initGruppen()
    '70~0, dh erster Gruppe, erstes Element
    arrGruppen(0).lng_01Unten = 70 - 70
    arrGruppen(0).lng_02Oben = 74 - 70
    
    arrGruppen(1).lng_01Unten = 75 - 70
    arrGruppen(1).lng_02Oben = 80 - 70
    
    arrGruppen(2).lng_01Unten = 81 - 70
    arrGruppen(2).lng_02Oben = 90 - 70

    arrGruppen(3).lng_01Unten = 70 - 70
    arrGruppen(3).lng_02Oben = 90 - 70
    
    arrGruppen(4).lng_01Unten = 91 - 70
    arrGruppen(4).lng_02Oben = 100 - 70

    arrGruppen(5).lng_01Unten = 95 - 70
    arrGruppen(5).lng_02Oben = 106 - 70
End Sub

Public Sub nichtDoppelteZufallszahlen()
    'Die Wahrsch. gleicher Zahl ist in niedriger Gesamtheit , Schleifendurchläufe bei großer aber zeitintensiver =>
    'zuerst grosse Bereich dann kleine für kurze Rekursion
    Dim bFound As Boolean
    Dim intZufall As Integer
    Dim intZähler As Integer
    intIndex = 5
    initGruppen
    Do
        DoEvents
        Randomize
        bFound = False
        intZufall = Int((arrGruppen(5 - intIndex).lng_02Oben - arrGruppen(5 - intIndex).lng_01Unten + 1) * Rnd + arrGruppen(5 - intIndex).lng_01Unten)
        For intZähler = 0 To 5
            If arrZahlen(intZähler) = intZufall Then
                bFound = bFound Or True
            End If
        Next intZähler
        If Not bFound Then
            arrZahlen(intIndex) = intZufall
            intIndex = intIndex - 1
        End If
        If intIndex  0 Then
            Exit Do
        End If
    Loop
    'Jetzt haben wir 6 Zahlen aus Gruppe 5 ...0
    '? arrzahlen(0);arrzahlen(1);arrzahlen(2);arrzahlen(3);arrzahlen(4);arrzahlen(5)
    '31  28  19  15  7  1
End Sub

'Ausführen
Public Sub gibAus()
    Dim wksDaten As Worksheet
    Dim wksBerechnungen As Worksheet
    'Hier den Namen der Datentabelle angeben
    'bei mir Tabelle1
    Dim strDaten As String
    Dim strBerechnungen As String
    Dim arrErgebnisse(5) As Double
    Dim intZähler As Integer
    Dim dblZahl As Double
    
    'Quell - und Zielbereich
    Dim rgQuelle As Range
    Dim rgZiele As Range
    'Rücksetzen
    For intZähler = 0 To 5
        arrZahlen(intZähler) = 0
    Next intZähler
    intZähler = 0
    'Anpassen, da nicht angegeben
    strDaten = "Tabelle1"
    strBerechnungen = "Berechnungen"
    
    Set wksDaten = ActiveWorkbook.Worksheets(strDaten)
    Set wksBerechnungen = ActiveWorkbook.Worksheets(strBerechnungen)
    Set rgQuelle = wksDaten.Range("F70:F106")
    
    nichtDoppelteZufallszahlen
    For intZähler = 0 To 5 '5 To 0 Step -1
        'Zielbereiche ggf anpassen
        'Zwei Zahlen in 1 Zelle ?
        Select Case intZähler
            Case 0
                Set rgZiele = wksBerechnungen.Range("E13")
            Case 1
                Set rgZiele = wksBerechnungen.Range("E14")
            Case 2
                Set rgZiele = wksBerechnungen.Range("F13")
            Case 3
                Set rgZiele = wksBerechnungen.Range("F14")
            Case 4
                Set rgZiele = wksBerechnungen.Range("J13")
            Case 5
                Set rgZiele = wksBerechnungen.Range("J14")
        End Select
        dblZahl = rgQuelle(arrZahlen(intZähler)).Value
        rgZiele.Value = dblZahl
    Next intZähler
End Sub

Sub unit() Dim aRng(5) As Range, rngOut As Range Dim i As Long, lngRnd As Long Dim wks As Worksheet Set wks = ThisWorkbook.Worksheets("Tabelle1") With wks Set aRng(0) = .Range("F70:F74") Set aRng(1) = .Range("F75:F80") Set aRng(2) = .Range("F81:F90") Set aRng(3) = .Range("F70:F90") Set aRng(4) = .Range("F91:F100") Set aRng(5) = .Range("F95:F106") Set rngOut = .Range("E13:J13") End With Dim aResult(5) As Variant For i = 0 To UBound(aRng) 'Redraw if duplicate Do lngRnd = WorksheetFunction.RandBetween(1, aRng(i).Rows.Count) lngRead = aRng(i).Cells(lngRnd, 1) Loop While (isinArray(aResult, lngRead)) aResult(i) = lngRead Next rngOut = aResult With wks.Sort .SetRange rngOut .Header = xlGuess .MatchCase = False .Orientation = xlLeftToRight .SortMethod = xlPinYin .Apply End With MsgBox "Finished" End Sub Private Function isinArray(myArray() As Variant, myValue As Variant) As Boolean Dim i As Long For i = LBound(myArray) To UBound(myArray) If myArray(i) = myValue Then isinArray = True Exit Function End If Next isinArray = False End Function

Beliebteste Forumthreads (12 Monate)

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

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread