Zufällige Auswahl von 20% aller Zeilen und Kopieren in ein anderes Tabellenblatt
#1
Hallo und guten Abend,
hoffe jemand kann mir bei folgender Herausforderung helfen:

Im Tabellenblatt "Source" befinden sich eine gewisse, vorher nicht eindeutige Anzahl von Datensätzen.

Ich möchte nach dem Zufallsprinzip 20% der Datensätze auswählen (wenn z.b. 100 Datensätze, dann sollen 20 nach Zufall ausgewählt werden), und die Spalten "A" bis "I" der ausgewählten Datensätze kopieren und in die Tabelle "COUNT_SOURCE" ab aktiver Zelle "A5" einfügen.
Bei nochmaliger Ausführung sollten dann wieder nach Zufallsprinzip andere Datensätze ausgewählt werden, also nicht immer die gleichen.

Die Auswahl im "Source" Datenblatt sollte anschließend mit Schriftfarbe "Blau" formatiert werden. (nicht zwingend erforderlich)

Habe keine wirkliche Idee wie ich das ganze angehen sollte und wäre für Hilfe oder Tipps ( oder sogar die Lösung) dankbar.

Gruß
Dirk
Top
#2
Hallo,

Vermutlich habe ich die Fragestellung nicht völlig verstanden, aber einfach geantwortet, es gibt die Funktion 'zufall' bzw' 'zufallsbereich'. Daraus einen Ansatz abzuleiten, jeden 5-ten Datensatz zu auszuwählen, ist recht einfach.

Mfg
Top
#3
Hi,
danke für die schnelle Antwort, Die Funktionen habe ich auch gesehen aber ich brauche eine VBA Lösung und weiß nicht wie ich das einabauen kann. Hier noch mal der Versuch mein Anliegen genauer zu erklären:

Aus der Tabelle: Source sollen von den dort enthaltenden Datensätzen (zur Zeit 48) willkürlich 20% (in dem Fall 10 Datensätze) ausgewählt und die Tabelle "Count_template" kopiert werden (nur die Spalten "A:I")
(Die Anzahl Datensätze in der Tabelle ist variabel und wird monatlich neu geladen).

1. -Ermittele Anzahl Datensätze in Tabelle "Source"
2.- Berechne 20% von Gesamtanzahl Datensätze
3.- Markiere "zufällige" Datensätze bis 20% Anzahl erreicht
4.- Kopiere Spalten A:I dieser Datensätze in Tabelle "COUNT_TEMPLATE" ab Zelle A5

Ich habe auch noch eine Beispieldatei hochgeladen.
Das enthaltene Makro kopiert zur Zeit alle Datensätze, aber ich brauche wie gesagt nur "20% zufällig ausgewälhter Datensätze".

Wird die Fragestellung damit klarer?

Vielen Dank
Dirk


Angehängte Dateien
.xlsm   Testfile.xlsm (Größe: 80,12 KB / Downloads: 3)
Top
#4
Hallo!
Mal so als Gedankenspiel, ohne mir die Datei angesehen zu haben:
  1. Wandel Deine Tabelle in ein Listobject um (Einfügen, Tabelle)
  2. Füge als erste Spalte die Funktion Zufallszahl() ein
  3. Filtere die Tabelle nach den TopTen (per Makro)
Jetzt kommt der dirty trick:
Man kann ja auch nach den Top 8 oder Top 15 filtern, oder VBA das obere Fünftel errechnen lassen.

Als Makro (entscheidend ist hier Criteria1:=):

Sub Oberste20Prozent()
    ActiveSheet.ListObjects("Tabelle1").Range.AutoFilter _
      Field:=1, _
      Criteria1:=Int(WorksheetFunction.Count(Range("Tabelle1[A]")) \ 5), _
      Operator:=xlTop10Items
End Sub

Gruß Ralf
Gib einem Mann einen Fisch und du ernährst ihn für einen Tag. 
Lehre einen Mann zu fischen und du ernährst ihn für sein Leben. (Konfuzius)
Top
#5
Code:
Sub M_snb()
    sn = Sheets("source").Cells(1).CurrentRegion
    
    Sheets("source").Cells(1).CurrentRegion.Resize(, 1).Offset(, 26).Name = "snb_001"
    Range("snb_001") = "=rand()"
    sp = [index(rank(snb_001,snb_001),)]
    Sheets("source").Columns(27).ClearContents
    
    For j = 1 To UBound(sn) \ 5
       c01 = c01 & " " & Application.Match(j, sp, 0)
    Next
    sp = Application.Index(sn, Application.Transpose(Split(Trim(c01))), [transpose(row(1:23))])

    Tabelle9.Cells(1).Resize(UBound(sp), UBound(sp, 2)) = sp
End Sub
Top
#6
Hallo,

Die vorgeschlage Lösung dürfte perfekt sein, aber hier eine Möglichkeit ohne Ranking:

Option base =1
Sub jede_5_Zeile kopieren()
Anzahl = WorksheetFunction.Count(Columns("A"))
ReDim Arr(Anzahl)
I=1
Do While i<= Int(Anzahl / 5+0.5)
K = WorksheetFunction.Max(2, Int(Anzahl * rnd +0.5)
If IsEmpty(Arr(k)) then
Sheets("tabelle1").Range("A" & k & "B:"&k).copy
Sheets("tabelle2").Range("a4").offset(i,0).pastespecial
Arr(k)=1
I=i+1
End if
Loop
End sub

Mfg
Top
#7
Hi Fennek,
besten Dank die Hilfe.
Muss leider zugeben das ich den VBA Inhalt nicht wirklich verstehe.

Habe den Code mal rüberkopiert, bekomme hier ein Kompilierungsfehler:

K = WorksheetFunction.Max(2, Int(Anzahl * rnd + 0,5)

Könntest Du noch mal schauen bitte? Wenn da was geht wäre klasse.

Viele Grüße
Dirk
Top
#8
Hi snb,
auch Dir vielen Dank für den Code.

Wie auch beim Fennek, leider verstehe ich das ganze nicht wirklich, habe aber den Code auch rüberkopiert und laufen lassen.

Klappt prima, wollte nur in dem Code "Tabelle9" in einen anderen Tabellennamen ändern und danach bekam ich eine Fehlermeldung, "Object nicht definiert" -- hatte die neue Tabelle vorher aber angelegt bzw. umbenannt.
Name war "RANDOM".

Nochmals Vielen Dank für Eure Mühen.

Gruß
Dirk
Top
#9
Hallo,

In der Formel

K =

Fehlt am Ende eine )

Mfg

[Eingabe vom Tablet, Anpassungen, z.b. Tabellen-Namen müßte der user vornehmen]
[-] Folgende(r) 1 Nutzer sagt Danke an Fennek für diesen Beitrag:
  • Gigbert62
Top
#10
Nochmals Dank an Euch.

Klappt prima!!


GD
Top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste