Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen

Zufällige Auswahl aus vorgegeben Werten

Betrifft: Zufällige Auswahl aus vorgegeben Werten von: Tess
Geschrieben am: 18.07.2013 16:41:18

Hallo Ihr Lieben!

Da es hier immer so tolle Lösungen gibt, komme ich heute mal mit einem (aus meiner Sicht) kniffligen Problem auf euch zu.
Ich möchte aus einer Spalte die insgesamt 72 Werte enthält drei verschiedene Mittelwerte berechnen, indem jeweils 24 Werte aus diesen Werten zufällig ausgewählt werden.
Wichtig hierbei ist, dass jeder Wert nur einmal genutzt wird und die Auswahl eben zufällig stattfindet.
Ich finde hier überhaupt keinen vernünftigen Ansatzpunkt... Vielleicht hat ja jemand von euch eine hilfreiche Idee.

Vielen, vielen Dank!
Viele Grüße
Tess

  

Betrifft: Tipp: Lösungsweg von: Luc:-?
Geschrieben am: 18.07.2013 19:30:13

Hallo Tess;
zuerst musst du sicherstellen, dass die Zufallsauswahl stets 24 verschiedene Werte auswählt. Dazu findest du garantiert eine Lösung bei ExcelFormeln. Nur benötigst du ja komplette ZellAdressen bzw je nach DatenAnordnung Zeilen- u/o SpaltenNrn (ggf für die INDEX-Fkt).
Nach der 1.Auswahl muss ein neuer Auswahlbereich ohne die bereits gewählten angelegt wdn. Nach der 2. ist es dann sehr einfach, nämlich der verbliebene Rest der Datenwerte.
Mit VBA ist das sicher lösbar, mit Formeln könnte es knifflig wdn. Mal sehen! ;-)
Gruß Luc :-?


  

Betrifft: AW: Tipp: Lösungsweg von: Frank
Geschrieben am: 18.07.2013 19:33:44

Hallo Tess,

anbei eine Datei die denke ich das ist wonach du suchst. Den Code habe ich auch nur im Netz gefunden und auf dein Problem angepasst.

Ich habe mir diese Lösung angesehen bzw. eingegeben. Leider sind die Zahlen trotzdem doppelt. Funktioniert bei jemanden dieser Lösungsansatz?

http://www.excelformeln.de/formeln.html?welcher=152

https://www.herber.de/bbs/user/86448.xls

Viele Grüße
Frank


  

Betrifft: AW: Tipp: Lösungsweg von: Frank Arendt-Theilen
Geschrieben am: 18.07.2013 19:38:58

Hallo,
folgender Lösungsvorschlag:
1) Trage in die Zellen A1:A72 deine Werte ein, aus denen die Mittelwerte gebildet werden sollen.
2) Trage in die Zelle B1:B72 die Formel =ZUFALLSZAHL() ein.

Für die ersten 24 Werte gilt die Matrixformel:
=MITTELWERT(WENN(RANG.GLEICH(B1:B72;B1:B72;1)<=24;A1:A72))

Für die zweiten 24 Werte gilt die Matrixformel:
=MITTELWERT(WENN((RANG.GLEICH(B1:B72;B1:B72;1)>24)*(RANG.GLEICH(B1:B72;B1:B72;1)<49);A1:A72))

Für die dritten 24 Werte gilt die Matrixformel:
=MITTELWERT(WENN(RANG.GLEICH(B1:B72;B1:B72;1)>=49;A1:A72))

Wichtig: Beeende jeweils die Formeleingabe mit der Tastenkombination Strg+Umsch+Enter.


Mit freundlichem Gruß aus der Rattenfängerstadt Hameln
Frank Arendt-Theilen
---
at-exceltraining.de


  

Betrifft: AW: Tipp: Lösungsweg von: Tess
Geschrieben am: 19.07.2013 08:56:00

Hallo!
Entschuldigt bitte! Ich habe mich da wohl missverständlich ausgedrückt... Ich suche natürlich nach einer Lösung in VBA...
Vielleicht hat da jemand noch eine Idee??

Viele Grüße
Tess


  

Betrifft: So, dann mal auf der Basis meiner Alternative ... von: Luc:-?
Geschrieben am: 19.07.2013 21:29:38

…zu xlTrainer Franks Lösung, die im Grunde fast dasselbe, nur etwas anders tut und dabei auch Datenfelder verarbeiten kann (nur ist das mit der xlFkt ZUFALLSZAHL in nur einer Zelle nicht möglich → Zellenanzahl muss mit ZufallszahlenAnzahl übereinstimmen!), Folgendes, Tess
1. MatrixFml über 3 Zellen (nebeneinander, sonst wird noch MTRANS benötigt):
@VectAr(MITTELWERT(WENN(VERGLEICH(KKLEINSTE(Keep(RandAr(72));ZEILE(1:72));
Keep();0)<25;A1:A72));MITTELWERT(MTRANS(Between(VERGLEICH(KKLEINSTE(Keep();ZEILE(1:72));Keep();
0);25;48));A1:A72);MITTELWERT(WENN(VERGLEICH(KKLEINSTE(Keep();ZEILE(1:72));Keep();0)>48;A1:A72)))
@ weist darauf hin, dass es sich hierbei um eine sog MatrixFml handelt! Also einkopieren und die Eingabe entsprd abschließen! Den Rest macht Xl.
Wobei MTRANS(Between(…)) wieder durch ein Produkt analog Franks Lösung ersetzt wdn muss, weil ich die UDF Between noch nie publiziert hatte.
2. 3 UDFs, die auch von einer Subroutine verwendet wdn könnten. In diesem Fall musst du nur noch die passende Subroutine dazu schreiben. ;-)

Rem Bewahrt Letzt-Nicht-Fehler-Arg z.WdrVwend (idR in gleicher Fml)
'   Vs1.0 -LSr -cd:20130718 -1pub:20130719herber.de -lupd:20130718t
Function Keep(Optional ByVal Bezug)
    Static vorErg
    If Not IsMissing(Bezug) Then
        If IsError(Bezug) Then Else vorErg = Bezug
        Keep = Bezug
    ElseIf IsEmpty(vorErg) Then
        Keep = CVErr(xlErrNull)
    Else: Keep = vorErg
    End If
End Function

Rem Erzeugt horizVektor aus Zufallszahlen m.ElementeAnzahl lt Argmt
'   b.Vwend in Subroutinen u.1zellig (Mx)Fmln muss Arg angegeb wdn!
'   Vs1.0 -LSr -cd:20130719 -1pub:20130719herber.de -lupd:20130719t
Function RandAr(Optional ByVal Anzahl As Long)
    Dim ix As Long, erg() As Double, ac As Range
    On Error GoTo fx
    Randomize
    If Anzahl = 0 Then
        Set ac = Application.Caller
        If ac.HasArray Then Anzahl = ac.Count Else Anzahl = 1
    End If
    ReDim erg(1 To Anzahl)
    For ix = 1 To Anzahl: erg(ix) = Rnd(): Next ix
    RandAr = erg: GoTo ex
fx: If Err.Number >= xlErrNull And Err.Number <= xlErrNA Then
        RandAr = CVErr(Err.Number)
    Else: RandAr = "#F" & Err.Number & "!"
    End If
ex: Set ac = Nothing
End Function

Function VectAr(ParamArray Elemente())
    VectAr = Elemente
End Function
Gruß Luc :-?


  

Betrifft: Ergänzung: Statt der UDF VectAr kannst ... von: Luc:-?
Geschrieben am: 19.07.2013 21:35:08

…du natürlich auch meine im Archiv zu findende UDF Collect einsetzen, Tess;
diese ist zwar deutlich komplizierter (zu handhaben), dafür aber auch universeller. Außerdem enthält sie auch eine Memory-Fktionalität, so dass du auf die UDF Keep verzichten könntest.
Luc :-?


  

Betrifft: So, nun habe ich auch noch die benötigte ... von: Luc:-?
Geschrieben am: 20.07.2013 15:40:47

…Subroutine geschrieben, Tess;
da du aber bisher keine Infos zur Organisation des Ganzen geliefert hast, musst du das jetzt so akzeptieren wie es ist und ggf selbst anpassen…

Rem Bildet Mittelwerte gleichteilg Ziehgg aus Gesamtbereich ohne Wdholgg;
'   wtTeil=Anz gleichgroßer Teile, adQBer=Gesamt(zell)bereich - änderbar!
'   Achtung! Benötigt udFkt RandAr!
'   Vs1.1 -Luc -cd:20130720 -1pub:20130720herber.de -lupd:20130720t
Sub ZufallsMw_glTeil()
    Const wtTeil As Integer = 3, adQBer$ = "A2:A73"
    Dim anzWt As Long, ix As Long, iz As Long, az As Long, _
        oGrz() As Long, uGrz() As Long, erg() As Double, _
        isMoRows As Boolean, dzTrZ$, mxTrZ As String, _
        arQD, arZZ, zwErg(), zz As Variant, _
        QBer As Range, ZBer As Range, aSh As Worksheet, aWd As Window
    On Error GoTo fx
    dzTrZ = Application.International(xlDecimalSeparator)
    Set aSh = ActiveSheet: Set aWd = ActiveWindow
    Set QBer = aSh.Range(adQBer): Set ZBer = aWd.RangeSelection
    If ZBer.Rows.Count = 1 Then
        If ZBer.Columns.Count <> wtTeil Then Err.Raise xlErrRef
    ElseIf ZBer.Rows.Count <> wtTeil Then
        Err.Raise xlErrRef
    ElseIf ZBer.Columns.Count > 1 Then
        Err.Raise xlErrRef
    End If
    ReDim oGrz(wtTeil), uGrz(wtTeil), erg(1 To wtTeil)
    anzWt = QBer.Count: arZZ = RandAr(anzWt)
    Let isMoRows = QBer.Rows.Count > 1: mxTrZ = Array(",", ";")(Abs(isMoRows))
    If isMoRows Then ReDim zwErg(anzWt - 1, 0) Else ReDim zwErg(anzWt - 1)
    With WorksheetFunction
        arQD = .Transpose(.Transpose(QBer)): az = LBound(arQD)
        For ix = 1 To wtTeil
            oGrz(ix) = ix * anzWt \ wtTeil: uGrz(ix) = 1 + oGrz(ix - 1)
            For iz = 0 To anzWt - 1
                If isMoRows Then
                    zwErg(iz, 0) = .Match(.Small(arZZ, iz + 1), arZZ, 0)
                    zwErg(iz, 0) = IIf(zwErg(iz, 0) >= uGrz(ix) And _
                                   zwErg(iz, 0) <= oGrz(ix), arQD(iz + az, az), 0)
                Else: zwErg(iz) = .Match(.Small(arZZ, iz + 1), arZZ, 0)
                    zwErg(iz) = IIf(zwErg(iz) >= uGrz(ix) And _
                                zwErg(iz) <= oGrz(ix), arQD(iz + az), 0)
                End If
            Next iz
            erg(ix) = .Sum(zwErg) / oGrz(1)
        Next ix
        If ZBer.Rows.Count = 1 Then ZBer = erg Else ZBer = .Transpose(erg)
        GoTo ex
    End With
fx: If Err.Number = xlErrRef Then
        MsgBox "Bereichsauswahl entspricht nicht PgmParametern!", vbCritical, "Auswahl-Fehler"
    Else: MsgBox Err.Description, vbCritical, "Interner Fehler" ': Stop: Resume Next
    End If
ex: Set aSh = Nothing: Set aWd = Nothing: Set QBer = Nothing: Set ZBer = Nothing
End Sub
Falls es dich oder anderweitig interessiert — habe auch noch eine neue Version der UDF RandAr geschrieben, der zusätzlich ein Multi­plikations­faktor und eine max­Dezimal­Stellen­Anzahl übergeben wdn kann.
Gruß Luc :-?


  

Betrifft: wahrscheinlich WAHRSCHEINLICHKEIT beachten ... von: neopa
Geschrieben am: 19.07.2013 10:01:32

Hallo Frank,

... wahrscheinlich ist es eher unwahrscheinlich, dass im Normalfall die gleichen 72 Zufallszahlen entstehen. Aber ausschließen kann man es mE auch nicht.

Mein Vorschlag deshalb:

eine zweite Hilfsspalte (in C) und dort
=RANG(B1;B$1:B$72) nach unten kopieren und dann die drei Formeln:

=WENN(SUMME(N(HÄUFIGKEIT(C:C;C:C)>1))=0;SUMMENPRODUKT((C1:C72<25)*A1:A72)/24; "bitte nochmal F9 betätigen") 
=WENN(SUMME(N(HÄUFIGKEIT(C:C;C:C)>1))=0;SUMMENPRODUKT(((C1:C72>24)*(C1:C72<49))*A1:A72)/24; "bitte nochmal F9 betätigen") 
=WENN(SUMME(N(HÄUFIGKEIT(C:C;C:C)>1))=0;SUMMENPRODUKT((C1:C72>48)*A1:A72)/24; "bitte nochmal F9 betätigen") 

Gruß Werner
.. , - ...

oT
Jeder Interessent ist willkommen beim Exceltreffen 11.-13.10.2013 in Duisburg
Mehr dazu, siehe http://www.exceltreffen.de/index.php?page=230


  

Betrifft: Korrektur meines geschriebenen ... von: neopa
Geschrieben am: 19.07.2013 12:16:32

Hallo,

... meine geschriebene Aussage "wahrscheinlich ist es eher unwahrscheinlich, dass im Normalfall die gleichen 72 Zufallszahlen entstehen" sollte natürlich auch nach der Wahrscheinlichkeit unmöglich sein, oder?

Ich meinte und wollte schreiben: "wahrscheinlich ist es eher unwahrscheinlich, dass im Normalfall zwei gleiche von den 72 Zufallszahlen entstehen" Ein solcher Fall kann mE nicht von vornherein völlig ausgeschlossen werden.


Gruß Werner
.. , - ...

oT
Jeder Interessent ist willkommen beim Exceltreffen 11.-13.10.2013 in Duisburg
Mehr dazu, siehe http://www.exceltreffen.de/index.php?page=230


  

Betrifft: Aber Franks Lösung schließt den aus, ... von: Luc:-?
Geschrieben am: 19.07.2013 15:07:32

…Werner,
weshalb ich meinen Lösungsansatz, der eine gewisse Autokorrektur solcher Fälle enthielt, hier gar nicht mehr gezeigt habe.
Auf VBA-Basis (wg der Hilfszellen oder Einbindung in ein bestehendes Pgm?) dürfte das auch kein Problem sein, Tess.
Ein bisschen VBA war in Form einer UDF beim o.g. Lösungsansatz ohnehin schon mit im Spiel. Was noch benötigt würde, wäre eine UDF für (rekursive) Erzeugung beliebig langer Zufalszahlen-Datenfelder, mit denen KKLEINSTE als xlAltFkt ja im Ggsatz zu den msNeuFktt wie RANG&Co ja arbeiten könnte. Die xlAltFkt ZUFALLSZAHL ist ja ebenfalls an die externe xlinterne MatrixSteuerung gebunden und erzeugt auch in einer MatrixFml nur soviel unterschiedl Zufallszahlen wie Zellen ausgewählt wurden.
Gruß Luc :-?


  

Betrifft: Die einzige gleichwertige FmlAlternative ... von: Luc:-?
Geschrieben am: 19.07.2013 19:28:57

…dürfte die nflgd auf gleicher ZUFALLSZAHL-Basis sein, Werner,
die aber etwas anders auswählt und deshalb andere Ergebnisse liefert…
1.Ziehung: {=MITTELWERT(WENN(VERGLEICH(KKLEINSTE(B1:B72;ZEILE(1:72));B1:B72;0)<25;A1:A72))}
2.Ziehung: {=MITTELWERT(MTRANS(Between(VERGLEICH(KKLEINSTE(B1:B72;ZEILE(1:72));B1:B72;0);25;48));A1:A72)}
3.Ziehung: {=MITTELWERT(WENN(VERGLEICH(KKLEINSTE(B1:B72;ZEILE(1:72));B1:B72;0)>48;A1:A72))}
Dabei kann die UDF Between durch eine Franks Lösung analoge Multiplikation ersetzt wdn.
Gruß Luc :-?


  

Betrifft: mir geht es nicht um die Auswertungsformeln ... von: neopa
Geschrieben am: 21.07.2013 11:46:04

Hallo Luc,

... mir ging und geht es hier um die Wahrscheinlichkeit, dass es bei 72x ZUFALLSZAHL() nicht ganz unwahrscheinlich ist, dass diese irgendwann mal eben nicht 72 verschiedene Zahlen ergibt und dann die Forderung von Tess nicht eingehalten ist. Ich weiß die Wahrscheinlichkeit geht gegen 0 ist aber sie ist nicht 0. Aus diesem Grund hatte ich die die zweite Hilfsspalte eingeführt, um als erstes die Ungleichheit der 72 Zufallszahlen auszuwerten. Denn wenn die Unwahrscheinlichkeit eintritt, dass zwei Zufallszahlen gleich sind, gibt es bei einer "reinen" RANG() oder auch KKLEINSTE() Auswertung eben eine von Tess nicht gewollte Auswertung. Wie die Auswertungsformel dann erfolgt, da gibt es sicherlich viele Möglichkeiten, aber solange nicht geklärt ist, wie ernst es Tess mit Ihrer aufgestellten Bedingung ist, wollte ich auf diesen Fakt hinweisen. Vielleicht ist mir das ja nun etwas besser gelungen als bisher.

Gruß Werner
.. , - ...

oT
Jeder Interessent ist willkommen beim Exceltreffen 11.-13.10.2013 in Duisburg
Mehr dazu, siehe http://www.exceltreffen.de/index.php?page=230


  

Betrifft: Mit meinem ursprgl Ansatz war bei Kontrolle ... von: Luc:-?
Geschrieben am: 21.07.2013 18:52:11

…durch BedingtFormat Doppelte trotz AutoKorrekturoption (bis zu 4maliger Neuberechnung durch WENN-Konstrukt) ab-und-zu zu sehen, dass Doppelte auftraten, Werner;
bei analoger Kontrolle der Ergebnisse von Franks und meinen beiden neuen Fml-Varianten kam das bisher kein einziges Mal vor, obwohl die Zahlen inzwischen x-mal neu berechnet wurden… ;-)
Gruß+schöRestSo, Luc :-?


  

Betrifft: ...Und, wat nu? Urlaub, zu heiß? :-( von: Luc:-?
Geschrieben am: 23.07.2013 13:28:58

:-?


 

Beiträge aus den Excel-Beispielen zum Thema "Zufällige Auswahl aus vorgegeben Werten "