Mehrmalige Stichprobe - Druckversion +- Office-Fragen.de (https://office-fragen.de) +-- Forum: Microsoft Office (https://office-fragen.de/forum-1.html) +--- Forum: Excel (https://office-fragen.de/forum-2.html) +--- Thema: Mehrmalige Stichprobe (/thread-1804.html) |
Mehrmalige Stichprobe - Alexandra123ize - 03.08.2019 Hallo liebe Community, ich würde gerne eine Stichprobenziehung in Excel mehrmals durchführen. Ich möchte aus 100 Zahlen 10 Stück ziehen und diesen Prozess 1.000 mal durchführen. Über "Daten" --> "Datenanalyse" ist es ja grundsätzlich möglich eine einmalige Stichprobe durchzuführen also 10 aus 100 zu ziehen. Daher ist meine Frage ob es eine Möglichkeit gibt, diesen Schritt von Excel 1000 mal durchführen zu lassen? Oder kennt jemand einen anderen Lösungsweg? Ich bin jeder Hilfe dankbar! Viele Grüße Alexandra123ize RE: Mehrmalige Stichprobe - GMG-CC - 03.08.2019 Moin Alexandra, zeichne dein Vorhaben mit dem VBA-Makrorekorder auf und verpasse dem Kern-Code eine Zählschleife (For I = 1 To 1000). Die Zelle für die Ausgabe entsprechend anpassen. RE: Mehrmalige Stichprobe - Alexandra123ize - 03.08.2019 Hallo Günter, danke für die schnelle Antwort. Leider habe ich noch nie mit Makros gearbeitet. Taste mich gerade mit Youtube Videos heran. Ich hatte das gleiche schon probiert. Habe versucht das Makro aufzuzeichnen, aber den Part der Datenanalyse wurde dann irgendwie nicht aufgezeichnet. Meinst du, du kannst mir das genauere Vorgehen erklären? Viele Grüße Alexandra123ize Ich zeige dir mal meine Excel Datei, damit das ganze verständlicher wird. Ich möchte aus den 50 EBIT Margen aus Tabelle 1 "Data", 1000 mal 10 Stichproben ziehen und diese in Tabelle 2 "Stichproben" nebeneinander anordnen. Hab dir auch mal die Excel-Datei angehangen. Viele Dank für deine Hilfe! RE: Mehrmalige Stichprobe - Alexandra123ize - 03.08.2019 Ziehen soll ohne Zurücklegen sein RE: Mehrmalige Stichprobe - Alexandra123ize - 04.08.2019 Habe es nun selbst mit Makros aus dem Internet und eigenen Makros zusammengewürfelt (Falls jemand das selbe machen möchte hier meine Lösung PS: Bitte keine Vorwürfe, das war der erste Makro-Versuch meines Lebens Aber es hat geklappt Sub AnzahlAnWiederholungen() 'Wiederhole die Makros unten 1000 mal Dim i As Long For i = 1 To 1000 Call Zufallswahl Next Call Stichprobennamen End Sub Sub Zufallswahl() 'Wähle 10 aus 50 durch Zufall Dim x As Variant With Worksheets("Data") x = ZufallsinhaltAusBereich(.Range("A1:A50"), 10) .Range(.Cells(2, 3), .Cells(UBound(x, 1), 3)) = x End With End Sub Function ZufallsinhaltAusBereich(Quellbereich As Range, _ ByVal Anzahl As Long) As Variant Dim varQuelle() As Variant Dim avarGezogen() As Variant Dim rngQuelle As Range Dim lngMax As Long Dim lngCount As Long Dim lngZahl As Long Dim colDoppelte As New Collection ' <Doppelte vermeiden> ReDim varQuelle(1 To Quellbereich.Cells.Count) ' Pool erstellen With Quellbereich On Error Resume Next ' <Doppelte vermeiden> For Each rngQuelle In Quellbereich If rngQuelle.Value <> "" Then ' Leere vermeiden ' <Doppelte vermeiden> Err.Clear colDoppelte.Add lngCount, "X" & CStr(rngQuelle.Value) If Err.Number = 0 Then ' </Doppelte vermeiden> lngCount = lngCount + 1 varQuelle(lngCount) = rngQuelle.Value End If ' <Doppelte vermeiden> End If Next On Error GoTo 0 ' <Doppelte vermeiden> End With ReDim Preserve varQuelle(1 To lngCount) If Anzahl > lngCount Then Anzahl = lngCount ReDim avarGezogen(1 To Anzahl, 1 To 1) lngMax = lngCount ' Wählen ohne Zurücklegen Randomize Timer For lngCount = lngMax To lngMax - Anzahl + 1 Step -1 lngZahl = Int((lngCount) * Rnd) + 1 avarGezogen(lngMax - lngCount + 1, 1) = varQuelle(lngZahl) varQuelle(lngZahl) = varQuelle(lngCount) Next ZufallsinhaltAusBereich = avarGezogen 'Neue Spalte Columns("B:B").Select Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove End Function Sub Stichprobennamen() 'Stichprobe 1,2 ... 1000 Range("C1").Select ActiveCell.FormulaR1C1 = "Stichprobe 1" Range("D1").Select ActiveCell.FormulaR1C1 = "Stichprobe 2" Range("E1").Select ActiveCell.FormulaR1C1 = "Stichprobe 3" Range("C1:E1").Select Selection.AutoFill Destination:=Range("C1:ALN1"), Type:=xlFillDefault Range("C1:ALN1").Select End Sub |