Zufällige Auswahl aus vorgegeben Werten

Tess · 2013-07-18T16:41:18+00:00

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

…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) 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 VectAr(ParamArray Elemente())
VectAr = Elemente
End Function

Gruß Luc :-?

…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) = uGrz(ix) And _
zwErg(iz)

Falls es dich oder anderweitig interessiert — habe auch noch eine neue Version der UDF RandAr geschrieben, der zusätzlich ein Multiplikationsfaktor und eine maxDezimalStellenAnzahl übergeben wdn kann.
Gruß Luc :-?

Zufällige Auswahl aus vorgegeben Werten

Forumthread: Zufällige Auswahl aus vorgegeben Werten

14
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Infobox / Tutorial