Stichprobe nehmen, zugehörigen Wert auslesen

Bild

Betrifft: Stichprobe nehmen, zugehörigen Wert auslesen
von: Bonduca
Geschrieben am: 29.10.2015 18:56:30

Hallo,
in meinem Quellblatt "A" Spalte F stehen Werte und in Spalte G zugehörige Namen.
Ich habe hier einen Code, der mir aus den Zahlen im Quellblatt "A" Spalte F eine Stichprobe im Umfang von n in das Zielblatt "B" ab der Zelle D27 schreibt.
Das funktioniert wunderbar.
Könnte man den Code so umfunktionieren, dass die zugehörigen Namen in Spalte G ebenfalls ausgelesen werden und in das Zielblatt eingetragen werden?
Am Schluss sollen also in D:E die Stichprobwerte mit den zugehörigen Namen stehen, die aus dem Quellblatt "A" F:G geholt wurden.

Sub StichProbe()
Dim Quelle As String
Dim Ziel As String
Dim ar As Variant
Dim Zielzellen As Variant
Dim n As Integer
'Dim arNeu As Variant, lngSize As Long, i As Long, lngZufall As Long
Quelle = "A"
Ziel = "B"
Sheets(Quelle).Activate
ar = Range("F4", Range("F4").End(xlDown))
n = 30 'Anzahl Zufallsziehungen bestimmen
Zielzellen = "D27"
Call StichProbe(Quelle, Ziel, ar, n, Zielzellen)
End Sub
Sub StichProbe(Quelle, Ziel, ar, n, Zielzellen)
Dim lngSize As Long
Dim lngZufall As Long
Dim arNeu As Variant
Dim i As Long
   
   Worksheets(Ziel).Activate
   ' Werte in Array lesen
   lngSize = UBound(ar)                      ' Anzahl der Werte bestimmen
   
   ReDim arNeu(1 To 550, 1 To 1)
   
   Randomize Time
   For i = 1 To n
      If lngSize = 0 Then
      lngSize = UBound(ar)
      End If
      lngZufall = Int(lngSize * Rnd) + 1    ' Eine zufällige Zahl zwischen 1 ... lngSize
      arNeu(i, 1) = ar(lngZufall, 1)         ' Diesen Wert umkopieren
      ar(lngZufall, 1) = ar(lngSize, 1)      ' Diesen Wert durch das letzte Array-Element  _
ersetzen
      lngSize = lngSize - 1                  ' max. Zufallszahl reduzieren
      
   Next
      'Worksheets(Ziel).Range("A1").Resize(n).Value = arNeu         ' umkopieren
   Sheets(Ziel).Range(Zielzellen).Resize(n).Value = arNeu
End Sub

Danke!

Bild

Betrifft: AW: Stichprobe nehmen, zugehörigen Wert auslesen
von: Esmo
Geschrieben am: 30.10.2015 01:10:23
Hallo Bonduca,
wenn die Werte in der Stichprobe eindeutig sind, könnte man die Namen ja mit einem SVERWEIS rausholen:

  Call StichProbe(Quelle, Ziel, ar, n, Zielzellen)
  Range("E27:E" & 27 + n - 1).FormulaR1C1 = "=VLOOKUP(RC[-1],'" & _
       Quelle & "'!R4C6:R" & _
       Sheets(Quelle).Range("F4").End(xlDown).Row & "C7,2,FALSE)"
End Sub

Falls nicht, mußt Du die in ein Feld stecken, daß Du beim Stichprobe ziehen anlegst:
Sub StichProbe(Quelle, Ziel, ar, n, Zielzellen)
  Dim lngSize As Long
  Dim lngZufall As Long
  Dim arNeu As Variant
  Dim arName(n) As Variant
  Dim i As Long
 
  Worksheets(Ziel).Activate
  ' Werte in Array lesen
  lngSize = UBound(ar)                      ' Anzahl der Werte bestimmen
   
  ReDim arNeu(1 To 550, 1 To 1)
   
  Randomize Time
  For i = 1 To n
    If lngSize = 0 Then
      lngSize = UBound(ar)
    End If
    lngZufall = Int(lngSize * Rnd) + 1    ' Eine zufällige Zahl zwischen 1 ... lngSize
    arNeu(i, 1) = ar(lngZufall, 1)  ' Diesen Wert umkopieren
    arName(i) = Sheets(Quelle).Range("G" & 4 + lngZufall)
    ar(lngZufall, 1) = ar(lngSize, 1)      ' Diesen Wert durch das letzte Array-Element _
ersetzen
      lngSize = lngSize - 1                  ' max. Zufallszahl reduzieren
      
   Next
      'Worksheets(Ziel).Range("A1").Resize(n).Value = arNeu         ' umkopieren
   Sheets(Ziel).Range(Zielzellen).Resize(n).Value = arNeu
   Sheets(Ziel).Range(Zielzellen).Offset(0, 1).Resize(n).Value = arName
End Sub


Bild

Betrifft: AW: Stichprobe nehmen, zugehörigen Wert auslesen
von: Bonduca01
Geschrieben am: 02.11.2015 13:18:46
Super! Super! Super!
Vielen Dank!
Das hat mir wirklich weiter geholfen.

Bild

Betrifft: AW: Stichprobe nehmen, zugehörigen Wert auslesen
von: Daniel
Geschrieben am: 02.11.2015 13:59:40
Hier eine ganz einfache Methode, um aus einer Liste eine beliebige Anzahl von zufälligen Stichproben zu ziehen ohne dass ein Wert 2x gezogen werden kann (Ziehen ohne zurücklegen)
1. schreibe in die Quelldatei in die erste freie Spalte am Tabellenende die Formel: =Zufallszahl()
und ziehe diese soweit nach unten wie benötigt
2. sortiere die Quelldatei nach dieser Spalte mit den zufallszahlen
3. kopiere die ersten n Zeilen dieser umsortierten Liste in deine Zieldatei.
sieht als Code dann so aus (Spalte für die Zufallszahlen ist H)


n = 30
With Sheets("Quelle")
    With .Range(.Cells(4, 6), .cells(4, 6).end(xldown))
        .Offset(0, 2).formulaR1C1 = "=Rand()"
        .Resize(, 3).Sort Key1:=.cells(1, 3), order1:=xlascending, Header:=xlno
        .Resize(n, 2).Copy Destination:=Sheets("Ziel").cells("D27") 
        .Offset(0, 2).clearContents
    end with
end with

Gruss Daniel

 Bild

Beiträge aus den Excel-Beispielen zum Thema "Stichprobe nehmen, zugehörigen Wert auslesen"