Per Inputbox Zufallszahlen in Zellbereich ohne doppelte

13.05.2025 17:20:30

Dieter(Drummer)

Guten Tag an alle.

In der Musterdatei wird im Bereich B3:B8 ein Zahl von + 10 und minus 10, ohne doppelte erzeugt. Das funktioniert.

Im Code: "Zufall", suche ich die Möglichkeit, per Inputbox, den Bereich und die Zufallszahlen im neuen Bereich, ohne doppelte, einzugeben.
Der max- und min Zahlenbereich soll per Inputbox definierbar und ausführbar sein.

Falls es auch möglich ist, den neuen Bereich im Code: "Farbbalken_im_Bereich", auch zu übernehmen, wäre es super.

Mit der Bitte um Hilfe, grüßt
Dieter(Drummer)
Musterdatei:
https://www.herber.de/bbs/user/177431.xlsm
Code "Zufall"
'Herber:https://www.herber.de/mailing/Zufallszahlen_generieren_die_sich_nicht_wiederholen.htm

Sub Zufall() 'Ohne doppelte
Dim rng As Range, rngAll As Range
Dim iRandomize As Integer
Set rngAll = Range("B3:B8")
Randomize
rngAll.ClearContents
For Each rng In rngAll.Cells
iRandomize = Int((10 * Rnd) + 1)
Do Until WorksheetFunction.CountIf(rngAll, iRandomize) = 0
iRandomize = Int((10 * Rnd) - 10)
Loop
rng.Value = iRandomize
Next rng
Range("B3:B8").NumberFormat = "0.00_ ;[Red]-0.00 "
End Sub

Code: "Farbbalken_im_Bereich"
Sub FarbBalken_im_Bereich()

With ActiveSheet
.Range("C3") = ("=B3")
.Range("C4") = ("=B4")
.Range("C5") = ("=B5")
.Range("C6") = ("=B6")
.Range("C7") = ("=B7")
.Range("C8") = ("=B8")
End With

Range("C3:C8").Select
Selection.FormatConditions.AddDatabar
Selection.FormatConditions(Selection.FormatConditions.Count).ShowValue = False 'Zellinhalt nicht zeigen
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1)
.MinPoint.Modify newtype:=xlConditionValueAutomaticMin
.MaxPoint.Modify newtype:=xlConditionValueAutomaticMax
End With
With Selection.FormatConditions(1).BarColor
.Color = 5287936
End With
Selection.FormatConditions(1).BarFillType = xlDataBarFillSolid
Selection.FormatConditions(1).Direction = xlContext
Selection.FormatConditions(1).NegativeBarFormat.ColorType = xlDataBarColor
Selection.FormatConditions(1).BarBorder.Type = xlDataBarBorderNone
Selection.FormatConditions(1).AxisPosition = xlDataBarAxisAutomatic
With Selection.FormatConditions(1).NegativeBarFormat.Color
.Color = 255
End With
Range("A2").Select
End Sub

AW: Per Inputbox Zufallszahlen in Zellbereich ohne doppelte

13.05.2025 17:47:17

velo

Hallo,

bezüglich des Zufallsbereichs per Inputbox:

Sub Zufall_V2()

    Dim rng As Range, rngAll As Range

    Dim iRandomize As Integer

    

    Dim Lowerbound As Integer

    Dim Upperbound As Integer

    

    Set rngAll = Range("A1:E5")

    

    Do While (Lowerbound = 0 And Upperbound = 0) Or (Upperbound = Lowerbound) Or (rngAll.Cells.Count > Upperbound - Lowerbound + 1)

        Lowerbound = InputBox("Kleinstmögliche Zahl", "Zufallsbereich")

        Upperbound = InputBox("Größtmöglichste Zahl", "Zufallsbereich")

    Loop

    

    Randomize

    rngAll.ClearContents

    For Each rng In rngAll.Cells

        iRandomize = Int((Upperbound - Lowerbound + 1) * Rnd + Lowerbound)

        Do Until WorksheetFunction.CountIf(rngAll, iRandomize) = 0

            iRandomize = Int((Upperbound - Lowerbound + 1) * Rnd + Lowerbound)

        Loop

        rng.Value = iRandomize

    Next rng

End Sub

Es wird solange nach der kleinsten / größten Zahl gefragt bis alle der folgenden Bedingungen eintreffen:
- Eine der Zahlen ist ungleich 0
- Upperbound ist größer als Lowerbound
- Der Zellbereich ist mindestens so groß wie der Zufallsbereich (sprich bei 20 Zellen kann man nicht einen Bereich von 1 bis 5 haben)

Hoffe es hilt!

VG
velo

AW: Per Inputbox Zufallszahlen in Zellbereich ohne doppelte

13.05.2025 18:29:11

Dieter(Drummer)

Danke Velo,

für Rückmeldung und Code, der funktioniert. Allerdings muss der Bereich im Code definiert sein/werden.

Gibt es auch die Variante, dass der Bereich auch per Inputbox definert werden kann?
Also Aufruf Inputbox, dann Bereich eingeben, dann in Inputbox kleinste und größte Zahl definieren.

Wäre toll wenn das auch noch möglich wäre.

Gruß,
Dieter(Drummer]

AW: Habe Variante gefunden

13.05.2025 19:08:28

Dieter(Drummer)

Hallo Velo,

habe den Bereich per Inputbox definiert und dann deinen Code "Zufall_V2" aufgerufen.
Nach Eingabe der Minuszahl und der Pluszahl, werden die Zufallszahlen in dem definierten Bereich erzeugt. das klappt.

Wie ich den Code "Inputbox_Bereich" auch in deinen Code "Zufall_V2" mit einbauen kann, da fehlt mit leider die Möglichkeit.

Vielleicht kannst du da nochmal helfen.

Mit Gruß,
Dieter(Drummer)

Code für Bereich:

Sub Inputbox_Bereich()

Dim rngZellbereich As Range

Set rngZellbereich = Application.InputBox(prompt:="Bereich", Title:="Defination", Type:=8)

Call Zufall_V2

End Sub

AW: Habe Code jetzt erweitert

13.05.2025 19:38:44

Dieter(Drummer)

Hallo Velo,

habe jetzt deinen Code erweitert mit Bereich per Inputbox und jetzt klappt es wie ich mir das vorgestellt habe.
Danke dir ...

Gruß, Dieter(Drummer)

Code:

'Herber: velo 13.05.2025 15:47:17

'Mit Anpassung von Mx

Sub Zufall_V2()

    'Dim rng As Range, rngAll As Range

    Dim iRandomize As Integer

    

    Dim Lowerbound As Integer

    Dim Upperbound As Integer

    

    Dim rngZellbereich As Range

    Set rngZellbereich = Application.InputBox(prompt:="Bereich", Title:="Defination", Type:=8)



   'Set rngAll = Range("B3:B8")

    

    Do While (Lowerbound = 0 And Upperbound = 0) Or (Upperbound = Lowerbound) Or (rngZellbereich.Cells.Count > Upperbound - Lowerbound + 1)

        Lowerbound = InputBox("Kleinstmögliche -Zahl", "Zufallsbereich")

        Upperbound = InputBox("Größtmöglichste Zahl", "Zufallsbereich")

    Loop

    

    Randomize

    rngZellbereich.ClearContents

    For Each rngZellbereich In rngZellbereich.Cells

        iRandomize = Int((Upperbound - Lowerbound + 1) * Rnd + Lowerbound)

        Do Until WorksheetFunction.CountIf(rngZellbereich, iRandomize) = 0

            iRandomize = Int((Upperbound - Lowerbound + 1) * Rnd + Lowerbound)

        Loop

        rngZellbereich.Value = iRandomize

    Next rngZellbereich

End Sub

In einem aktuellen Excel …

13.05.2025 20:39:28

RPP63

Moin und off topic!
In einem aktuellen Excel regel man so etwas mittels recht simpler Formel:

	A	B	C
1	min	-10	-2
2	max	5	-1
3	Anzahl	7	-8
4			-7
5			-9
6			-4
7			-10
8

Zelle	Formel
C1	=ZEILENWAHL(SORTIERENNACH(SEQUENZ(B2-B1+1;;B1);ZUFALLSMATRIX(B2-B1+1));SEQUENZ(B3))

Aber dies nur am Rande.

Gruß Ralf

AW: Habe Code jetzt erweitert

14.05.2025 11:21:21

velo

Hallo Dieter,

freut mich, dass es funktioniert und du auch selbst auf die Lösung mit dem Bereich gekommen bist :)

VG
velo

AW: In Nebenzelle des gewählten Bereichs Farbbalken setzen

14.05.2025 14:11:29

Dieter(Drummer)

Hallo Velo,

es fehlt mir nur die Möglichkeit, jetzt in den rechten Nebenzellen des gewählten Bereichs, Farbballken zu erzeugen.
Das mach ich bisher mit dem Code "Farbbalken_im_Bereich". Hier ist wohl schon in der Nebenzelle, die im Code definiert ist, die entsprechende Formel eingefügt.

Gibt es die Variante, das per VBA in der Nebenzelle, des per Inputbox gewählten Bereichs, die Formel, Bezug auf die Zelle des Bereichs nimmt und dann der Farbbalken eingesetzt wird?

Wäre toll, wenn du da auch helfen könntest.

Mit Gruß,
Dieter(Drummer)

Bisheriger Code:
Sub FarbBalken_im_Bereich()
With ActiveSheet
.Range("C3") = ("=B3")
.Range("C4") = ("=B4")
.Range("C5") = ("=B5")
.Range("C6") = ("=B6")
.Range("C7") = ("=B7")
.Range("C8") = ("=B8")
End With

Range("C3:C8").Select
Selection.FormatConditions.AddDatabar
Selection.FormatConditions(Selection.FormatConditions.Count).ShowValue = False 'Zellinhalt nicht zeigen
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1)
.MinPoint.Modify newtype:=xlConditionValueAutomaticMin
.MaxPoint.Modify newtype:=xlConditionValueAutomaticMax
End With
With Selection.FormatConditions(1).BarColor
.Color = 5287936
End With
Selection.FormatConditions(1).BarFillType = xlDataBarFillSolid
Selection.FormatConditions(1).Direction = xlContext
Selection.FormatConditions(1).NegativeBarFormat.ColorType = xlDataBarColor
Selection.FormatConditions(1).BarBorder.Type = xlDataBarBorderNone
Selection.FormatConditions(1).AxisPosition = xlDataBarAxisAutomatic
With Selection.FormatConditions(1).NegativeBarFormat.Color
.Color = 255
End With
Range("A2").Select
End Sub

AW: In einem aktuellen Excel …

14.05.2025 11:16:37

Dieter(Drummer)

Danke Ralf für Info und Rückmeldung.

Ich wollte es aber nicht mt Formeln lösen, sondern per VBA mit Inputbox.

Gruß,
Dieter(Drummer)

Per Inputbox Zufallszahlen in Zellbereich ohne doppelte

Forumthread: Per Inputbox Zufallszahlen in Zellbereich ohne doppelte

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Per Inputbox Zufallszahlen in Zellbereich ohne doppelte

Forumthread: Per Inputbox Zufallszahlen in Zellbereich ohne doppelte

8 Beiträge zum Forumthread Beiträge zu diesem Forumthread

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread