Office-Fragen.de
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.


[Bild: Bildschirmfoto-2019-08-03-um-17-14-36.png]

[Bild: Bildschirmfoto-2019-08-03-um-17-14-30.png]

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ösungSmile

PS: Bitte keine Vorwürfe, das war der erste Makro-Versuch meines Lebens Big Grin 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