Live-Forum - Die aktuellen Beiträge
Datum
Titel
20.10.2025 10:29:26
Userform Multipage - Page auswählen
19.10.2025 21:57:06
Diagrammpunkte in unterschiedlichen Farben je nach Wert
19.10.2025 18:21:56
Prüfen, ob Bild geladen wurde
19.10.2025 15:24:14
VBA -Drucken nur, wenn ich mit bestimmtem WLAN verbunden bin
Keine passende Antwort im Forumarchiv gefunden?
Stelle deine Frage im Live-Forum
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1308to1312
1308to1312
Aktuelles Verzeichnis
Verzeichnis Übersicht
Verzeichnis Übersicht
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Zeilen per Zufall auswählen incl Bedingung

Forumthread: Zeilen per Zufall auswählen incl Bedingung

Zeilen per Zufall auswählen incl Bedingung
23.04.2013 21:41:57
Andy
Hallo zusammen,
ich habe eine Tabelle mit folgenden Muster: 

Berlin, Adresse1
Berlin, Adresse2
Berlin, Adresse100
Hamburg, Adresse1
Hamburg, Adresse2
Hamburg, Adresse300
mehrere weitere Orte mit vielen unterschiedlichen Adressen
Aus dieser Tabelle1 möchte ich 2 Prozent(aufgerundet) aller Zeilen je Ort per Zufall in die Tabelle2 kopieren.
Habt ihr hierzu eine Idee oder vielleicht einen Lösungvorschlag für mich?
Gruß Andy

Anzeige

18
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Zeilen per Zufall auswählen incl Bedingung
24.04.2013 01:35:11
Mustafa
Hallo Andy,
hier mal eine VBA Lösung :
Option Explicit
Sub Staedte()
Dim Anzahl As Long
Dim StartZeile As Long, EndZeile As Long, Zufallszeile As Long
Dim AlteZeile As Long, LetzteZeile As Long
Dim Zufall As Long
Dim LngI As Long, LngX As Long, LngY As Long
Dim Vergleich As String
Dim Liste(100) As Variant
Const Prozent = 2
Randomize
'Alte Einträge löschen aus den Spalten D und E
Range(Cells(2, 4), Cells(Rows.Count, 5)).ClearContents
'Städteliste aus Spalte A einlesen
For LngI = 2 To Cells(Rows.Count, 1).End(xlUp).Row
If Cells(LngI, 1)  Cells(LngI - 1, 1) Then
LngX = LngX + 1
Liste(LngX) = Cells(LngI, 1)
End If
Next
'Nach angegebener Prozentzahl Liste zufällig generieren
For LngY = 1 To LngX
Anzahl = WorksheetFunction.CountIf(Range("A2:A1201"), Liste(LngY))
StartZeile = WorksheetFunction.Match(Liste(LngY), Range("A1:A1201"), 0)
EndZeile = StartZeile + Anzahl - 1
Zufall = Anzahl * Prozent / 100
For LngI = 1 To Zufall
Zufallszeile = Round(Rnd() * Anzahl, 0) + StartZeile
If AlteZeile = Zufallszeile Then
LngI = LngI - 1
Else
AlteZeile = Zufallszeile
LetzteZeile = Cells(Rows.Count, 4).End(xlUp).Row + 1
Cells(LetzteZeile, 4) = Cells(Zufallszeile, 1)
Cells(LetzteZeile, 5) = Cells(Zufallszeile, 2)
End If
Next
Next
End Sub
Code gehört in ein Modul
Rückmeldung obs Hilft wäre nett.
Gruß aus der Domstadt Köln.

Anzeige
sieht schon gut aus
24.04.2013 11:56:33
Andy
Hallo Mustafa,
Dein Ansatz funktioniert schon ganz gut.
Es wäre schön, wenn noch zwei Änderungen einfließen könnten:
- wenn in einem Ort 70 Adressen vorhanden sind, wird mir per Zufall nur 1 Adresse angezeigt. Da 2% von 70 Adressen ein Ergebnis von 1,4 liefert, hier wäre es erforderlich, dass das 2%-Ergebnis immer aufgerundet wird.
-Meine Datentabelle hat noch Werte in den Spalten A-Z stehen. Hier wäre es schön, wenn das Ergebnis auf das Tabelleblatt 2 oder in ein neues Tabellenblatt geschrieben werden könnte. Ist dies auch möglich?
Vielen Dank schonmal für Deine Mühe!
Gruß Andy

Anzeige
AW: sieht schon gut aus
24.04.2013 23:09:43
Mustafa
Hallo Andy,
hier noch ein Versuch :
Option Explicit
Sub Staedte()
Dim Anzahl As Long
Dim StartZeile As Long, EndZeile As Long, Zufallszeile As Long
Dim AlteZeile As Long, LetzteZeile As Long
Dim Zufall As Long
Dim LngI As Long, LngX As Long, LngY As Long
Dim Vergleich As String
Dim Liste(100) As Variant
Const Prozent = 2
Dim Wks1 As Worksheet, Wks2 As Worksheet
Set Wks1 = Worksheets("Tabelle1")       ' Anpassen auf die Eingabetabelle
Set Wks2 = Worksheets("Tabelle2")       ' Anpassen auf die Ausgabetabelle
Randomize
'Alte Einträge löschen aus den Spalten A und B aus Tabelle 2
Wks2.Range(Wks2.Cells(2, 1), Wks2.Cells(Rows.Count, 2)).ClearContents
'Städteliste aus Spalte A einlesen aus Tabelle 1
For LngI = 2 To Wks1.Cells(Rows.Count, 1).End(xlUp).Row
If Wks1.Cells(LngI, 1)  Wks1.Cells(LngI - 1, 1) Then
LngX = LngX + 1
Liste(LngX) = Wks1.Cells(LngI, 1)
End If
Next
'Nach angegebener Prozentzahl Liste zufällig generieren in Tabelle 2
For LngY = 1 To LngX
Anzahl = WorksheetFunction.CountIf(Wks1.Range("A2:A1201"), Liste(LngY))
StartZeile = WorksheetFunction.Match(Liste(LngY), Wks1.Range("A1:A1201"), 0)
EndZeile = StartZeile + Anzahl - 1
Zufall = WorksheetFunction.RoundUp(Anzahl * Prozent / 100, 0)
For LngI = 1 To Zufall
Zufallszeile = Round(Rnd() * Anzahl, 0) + StartZeile
If AlteZeile = Zufallszeile Then
LngI = LngI - 1
Else
AlteZeile = Zufallszeile
LetzteZeile = Wks2.Cells(Rows.Count, 1).End(xlUp).Row + 1
Wks2.Cells(LetzteZeile, 1) = Wks1.Cells(Zufallszeile, 1)
Wks2.Cells(LetzteZeile, 2) = Wks1.Cells(Zufallszeile, 2)
End If
Next
Next
End Sub
Rückmeldung obs Hilft wäre nett.
Gruß aus der Domstadt Köln.

Anzeige
unterschiedliche % nach jedem Scriptlauf
25.04.2013 15:47:03
Andy
Hallo Mustafa,
auf den ersten Blick funktioniert Dein Script, jedoch werden mir bei mehreren Scriptläufen mit den gleichen Daten unterschiedliche %-Ergebnisse pro Ort ausgegeben.
Wenn 1 Adresse vorhanden ist, kommt als Ergebnis mal 1 (richtig) oder auch mal 0
Bei 65 Adressen kommt mal 3 oder auch 2(richtig)
Mir ist auch noch aufgefallen, dass das Ergebnis extrem abweichend ist, wenn die Orten durcheinander stehen. Hier hatte ich zB. bei 65 Adressen 24 Ergebnisse.
Gruß Andy

Anzeige
unterschiedliche % Ergebnisse pro Scriptlauf
25.04.2013 15:49:37
Andy
Hallo Mustafa,
auf den ersten Blick funktioniert Dein Script, jedoch werden mir bei mehreren Scriptläufen mit den gleichen Daten unterschiedliche %-Ergebnisse pro Ort ausgegeben.
Wenn 1 Adresse vorhanden ist, kommt als Ergebnis mal 1 (richtig) oder auch mal 0
Bei 65 Adressen kommt mal 3 oder auch 2(richtig)
Mir ist auch noch aufgefallen, dass das Ergebnis extrem abweichend ist, wenn die Orten durcheinander stehen. Hier hatte ich zB. bei 65 Adressen 24 Ergebnisse.
Gruß Andy

Anzeige
AW: unterschiedliche % Ergebnisse pro Scriptlauf
26.04.2013 06:05:06
Mustafa
Hallo Andy,
Es wird eine neue Tabelle erstellt wo die Städte sortiert werden in ein Array eingelesen und per nicht wiederholender Zufallszahl Adressen wiedergegeben.
Hier mein Versuch:
Option Explicit
Sub Staedte3()
Dim Wks1 As Worksheet, Wks2 As Worksheet
Dim LngLetzte As Long, LngCounter As Long
Dim StartZeile As Integer, EndZeile As Integer, LngZeile As Integer, Zeile As Long, Anzahl As  _
Long
Dim ZufallAnzahl As Long
Dim VarArr1() As String, VarArr2() As String
Dim Col1 As New Collection
Dim Wiederholungen() As Long
Const Prozent As Double = 0.02
Set Wks1 = Worksheets("Tabelle1")
Wks1.Copy After:=Wks1
ActiveSheet.Name = "NeueListe " & Worksheets.Count
Set Wks2 = ActiveSheet
Wks2.Range("A1").Sort key1:=Wks2.Range("A1"), order1:=xlAscending, Header:=xlNo
LngLetzte = Wks2.Cells(Rows.Count, 1).End(xlUp).Row
ReDim VarArr1(1 To LngLetzte)
ReDim VarArr2(1 To LngLetzte)
For LngCounter = 1 To LngLetzte
VarArr1(LngCounter) = Wks2.Cells(LngCounter, 1)
VarArr2(LngCounter) = Wks2.Cells(LngCounter, 2)
Next
Wks2.UsedRange.Delete
On Error Resume Next
For LngCounter = 1 To UBound(VarArr1)
Col1.Add VarArr1(LngCounter), CStr(VarArr1(LngCounter))
Next
On Error GoTo 0
For LngCounter = 1 To Col1.Count
Anzahl = UBound(Filter(VarArr1, Col1(LngCounter), True, 1)) + 1
StartZeile = Application.Match(Col1(LngCounter), VarArr1(), 0)
EndZeile = StartZeile + Anzahl - 1
ZufallAnzahl = WorksheetFunction.RoundUp(Anzahl * Prozent, 0)
'*****  Zufallszahlen ohne Wiederholungen von NEPUMUK   *****
Dim i As Integer, fFeld() As Integer, iTemp As Integer, iZ As Integer
ReDim fFeld(1 To Anzahl)
For i = 1 To Anzahl
fFeld(i) = i
Next i
For i = Anzahl To 1 Step -1
Randomize Timer
iZ = Int((i * Rnd) + 1)
iTemp = fFeld(iZ)
fFeld(iZ) = fFeld(i)
fFeld(i) = iTemp
Next i
ReDim Wiederholungen(1 To ZufallAnzahl)
For i = 1 To ZufallAnzahl
Wiederholungen(i) = fFeld(i)
Next i
'*****  Zufallszahlen ohne Wiederholungen von NEPUMUK   *****
For LngZeile = 1 To ZufallAnzahl
Zeile = Cells(Rows.Count, 1).End(xlUp).Row + 1
Cells(Zeile, 1) = VarArr1(Wiederholungen(LngZeile) + StartZeile - 1)
Cells(Zeile, 2) = VarArr2(Wiederholungen(LngZeile) + StartZeile - 1)
Next
Next
End Sub

Rückmeldung obs Hilft wäre nett.
Gruß aus der Domstadt Köln.

Anzeige
Klappt - Danke!
26.04.2013 13:07:00
Andy
Hallo Mustafa,
prima, jetzt funktioniert es!
Vielen Dank für Deine Unterstützung!
Gruß Andy

Danke für die Rückmeldung orT
27.04.2013 00:59:20
Mustafa
Gruß aus der Domstadt Köln.

nur Teilfunktion ohne VBA
24.04.2013 12:55:48
Andy
Hallo Klaus,
Deine Lösung funktioniert leider nicht. Bei folgenden Einstellungen kommt es zu einem fehlerhaften Ergebnis:
Anzahl Adressen: 300
davon ziehen: 2%
sind real: 6
Im Ergebnis werden die Berliner Adressen gar nicht berücksichtigt; hier sollte min. 1 Berliner Adresse erscheinen, da als Mindestanforderung 2% aller Adressen in jedem Ort gefordert war.
Gruß Andy

Anzeige
AW: nur Teilfunktion ohne VBA
24.04.2013 13:11:27
Klaus
Hi,
das je Ort hatte ich nicht drauf. Meine Lösung zieht x% der Adressen aus dem gesamten Pool.
Ich hab schon ne Idee, melde mich später nochmal!
Grüße,
Klaus M.vdT.

Zufall pro Gruppe (mit VBA)
25.04.2013 00:19:12
Erich
Hi Andy,
probier mal 

Option Explicit
Sub GruppenZufall()           ' Liste ist sortiert nach Spalte A
Dim lngQ As Long, arQA, arQB, nn As Long, zz As Long
Dim stOrt() As String, arBis() As Long, ii As Long, jj As Long
Dim anzW As Long, lngZ As Long, zDup() As Long, zuf As Long
Dim tt As Long, arErg()
Const Proz As Long = 2                          ' Auswahl von 2%
With Sheets("Tabelle1")                            ' Quelltabelle
lngQ = .Cells(.Rows.Count, 1).End(xlUp).Row
arQA = .Cells(1, 1).Resize(lngQ)
arQB = .Cells(1, 2).Resize(lngQ)
End With
ReDim stOrt(1 To lngQ)
ReDim arBis(0 To lngQ)
nn = 1
stOrt(nn) = arQA(1, 1)
For zz = 2 To lngQ
If stOrt(nn)  arQA(zz, 1) Then
arBis(nn) = zz - 1
nn = nn + 1
stOrt(nn) = arQA(zz, 1)
lngZ = lngZ + _
Application.RoundUp((arBis(nn - 1) - arBis(nn - 2)) * Proz / 100, 0)
End If
Next zz
arBis(nn) = lngQ
lngZ = lngZ + _
Application.RoundUp((arBis(nn) - arBis(nn - 1)) * Proz / 100, 0)
ReDim Preserve stOrt(1 To nn)
ReDim Preserve arBis(0 To nn)
ReDim arErg(1 To lngZ, 1 To 2)
zz = 0
Randomize
For ii = 1 To nn
anzW = arBis(ii) - arBis(ii - 1) - 1               ' Anz. Werte - 1
lngZ = Application.RoundUp(anzW * Proz / 100, 0)   ' Anz. Stichprobe
ReDim zDup(1 To lngZ)
For jj = 1 To lngZ
zz = zz + 1
zuf = Int(anzW * Rnd() + arBis(ii - 1)) + 1
Do                                              ' keine Dubletten
For tt = 2 To jj - 1
If zuf = zDup(tt - 1) Then Exit For
Next tt
zuf = Int(anzW * Rnd() + arBis(ii - 1)) + 1
Loop Until tt >= jj
arErg(zz, 1) = stOrt(ii)                        ' Ergebnis in Array
arErg(zz, 2) = arQB(zuf, 1)
Next jj
Next ii
Worksheets.Add Before:=Sheets(1)             ' Ausgabe in neuer Zieltabelle
Cells(1, 1).Resize(UBound(arErg), 2) = arErg
End Sub
Rückmeldung wäre nett! - Grüße aus Kamp-Lintfort von Erich

Anzeige
Zufall pro Gruppe (mit VBA) - neue Version
25.04.2013 07:38:02
Erich
Hi Andy,
so ist es etwas sicherer: 

Option Explicit
Sub GruppenZufall()           ' Liste ist sortiert nach Spalte A
Dim lngQ As Long, arQA, arQB, nn As Long, zz As Long
Dim stOrt() As String, arBis() As Long, ii As Long, jj As Long
Dim anzW As Long, lngZ As Long, zuf As Long
Dim tt As Long, arErg(), arZuf
Const Proz As Long = 2                             ' Auswahl von 2%
With Sheets("Tabelle1")                            ' Quelltabelle
lngQ = .Cells(.Rows.Count, 1).End(xlUp).Row
arQA = .Cells(1, 1).Resize(lngQ)       ' Spalte A
arQB = .Cells(1, 2).Resize(lngQ)       ' Spalte B
End With
ReDim stOrt(1 To lngQ)
ReDim arBis(0 To lngQ)
nn = 1
stOrt(1) = arQA(1, 1)
For zz = 2 To lngQ
If stOrt(nn)  arQA(zz, 1) Then
arBis(nn) = zz - 1
nn = nn + 1
stOrt(nn) = arQA(zz, 1)
anzW = arBis(nn - 1) - arBis(nn - 2)               ' Anz. Werte
lngZ = lngZ + Application.RoundUp(anzW * Proz / 100, 0)
End If
Next zz
arBis(nn) = lngQ
anzW = arBis(nn) - arBis(nn - 1)
lngZ = lngZ + Application.RoundUp(anzW * Proz / 100, 0)
ReDim Preserve stOrt(1 To nn)
ReDim Preserve arBis(0 To nn)
ReDim arErg(1 To lngZ, 1 To 2)
zz = 0
For ii = 1 To nn
anzW = arBis(ii) - arBis(ii - 1)                      ' Anz. Werte
If anzW
Rückmeldung wäre nett! - Grüße aus Kamp-Lintfort von Erich

Anzeige
nah dran, rundet nicht richtig
25.04.2013 14:15:31
Andy
Hallo Erich,
Dein Script ist schon sehr nah an der Lösung dran, jedoch rundet es nicht richtig.
Wenn 65 Adressen vorhanden sind erscheinen 3 Ergebnisse, richtig wäre 2
Wenn 108 Adressen vorhanden sind erscheinen 4 Ergebnisse, richtig wäre 3
es scheint so, als wäre der Wert immer um 1 zu hoch, jedoch bei einer Adresse erscheint 1 Ergebnis, hier ist es also richtig.
Gruß Andy

Anzeige
Änderung?
25.04.2013 16:51:00
Erich
Hi Andy,
hast du irgend etwas am Code geändert? Diese falsche "Rundung", das Ergebnis zuviel,
kann ich bei mir nicht beobachten.
Hier mal eine BeiSpielMappe: https://www.herber.de/bbs/user/85067.xlsm
Das Rätsel sollte sich lösen lassen...
Rückmeldung wäre nett! - Grüße aus Kamp-Lintfort von Erich

Anzeige
mit der Vorlage klappt es - Danke!
26.04.2013 13:12:27
Andy
Hallo Erich,
ich hatte am Code nichts geändert, habe jetzt Deine Vorlage benutzt und siehe da alles funktioniert.
Vielen Dank für Deine Unterstützung!
Gruß Andy

Fehlersuche
27.04.2013 18:49:11
Erich
Hi Andy,
"ich hatte am Code nichts geändert, habe jetzt Deine Vorlage benutzt und siehe da alles funktioniert"
Das erscheint mir nun aber sehr merkwürdig.
Ein Code, der in verschiedenen Mappen verschiedene Ergebnisse produziert?
Wie kannst du da sicher sein, dass in der nächsten Mappe nicht noch ein anderes Ergebnis erscheint?
Mich würde schon interessieren, wie der Fehler
    "Dein Script ist schon sehr nah an der Lösung dran, jedoch rundet es nicht richtig.
    Wenn 65 Adressen vorhanden sind erscheinen 3 Ergebnisse, richtig wäre 2
    Wenn 108 Adressen vorhanden sind erscheinen 4 Ergebnisse, richtig wäre 3"
entstand.
Wenn du den Fehler selbst nicht aufdeckst, wäre ich dir dankbar für das Hochladen einer Mappe, in der der Fehler auftritt.
Wie schrieb ich so schön: "Das Rätsel sollte sich lösen lassen..."
Rückmeldung wäre nett! - Grüße aus Kamp-Lintfort von Erich und: Schönes Wochenende!

Anzeige
AW: Fehlersuche
27.04.2013 20:27:16
Andy
Hallo Erich,
ich versuche den Fehler am Montag nochmal nachzustellen und melde mich dann nochmal.
Kann es vielleicht daran liegen, dass die Adressen nicht nach Orte sortiert in der Liste standen? Vor dem zweiten Versuch habe ich die Daten nach Orte sortiert.
Gruß Andy
;

Forumthreads zu verwandten Themen

Name aus einer Liste auswählen
Willi

Hallo Leute,
ich habe ein Problem wie folgt:
aus einer Spalte in der stehen die Lieferanten untereinander. Es gibt
sehr viele doppelte Eintragungen. Mein wunsch ist folgender:
in einem anderen Blatt möchte ich die Umsätze der Lieferanten zusammenfassen.
Dazu will ich in eine...
09.02.2011 12:56:50
Thread-ID: 1199853
5 Beiträge
1. Wert Auswahlliste auswählen
Stefan

Hallo zusammen,
ich erstelle mit u.a. Code eine Auswahlliste.
Weiß jemand wie man danach auch automatisch den 1. Wert der Auswahlliste wählt?
Bei mir ist die Zelle dann nämlich leer, die Auswahlliste ist aber selektierbar.
Sheets("Auswertung").Select
Range("ai7").Select
...
25.03.2017 11:43:27
Thread-ID: 1549431
3 Beiträge
Anzeige
Wenn(Oder(aus Liste auswählen...
Joerschi

Hallo liebes Forum,
wahrscheinlich sehe ich den Wald vor lauter Bäumen nicht und es ist supereinfach, aber trotzdem ...
Erst Grafik, dann kurze Beschreibung:

Musterdatei: https://www.herber.de/bbs/user/115004.xlsx
Gesucht sind die Formeln für B2:B9.
Es gibt eine fixe, v...
21.07.2017 20:44:28
Thread-ID: 1570401
5 Beiträge
Anzeige
Aus Liste maximal 20 auswählen und in neues Blatt
Hans

Hallo Forum,
ich habe in meiner Tabelle rund 47 Kontrollkästchen (ActiveX Steuerelemente) wovon ich gerne MAXIMAL 20 auswählen und den Text in ein neues Blatt (Rechnung) übernehmen möchte. (Das ganze hab ich mit "wenn-dann-sonst" versucht, bin aber kläglich gescheitert)
Neben den Namen...
05.12.2017 19:38:12
Thread-ID: 1595477
26 Beiträge
Zufälliger Eintrag aus Liste in neue Zeile ausgebe
Patrick

Hallo!
ich habe ein relativ einfaches Problem, das ich aber leider mit der Suchfunktion noch nicht lösen konnte.
In den Tabellenblättern "Tracks" und "Cars" stehen jeweils in Spalte A 151 bzw. 226 Texteinträge. Nun möchte ich, dass Excel per Button in ein neues Tabellenblatt "Combinatio...
25.06.2018 10:52:01
Thread-ID: 1630352
7 Beiträge
Zufällige Ausgabe eines Listenwertes
Alex

Hallo liebe Forums-Gemeinde,
mal wieder habe ich ein für mich schwer zu lösendes Problem.
Ich möchte mir aus einer Liste (Daten alle in einer Spalte) einen zufälligen Wert per Formel angeben lassen.
Ich hänge noch eine Datei mit an.
Alex
29.03.2020 08:36:17
Thread-ID: 1748875
4 Beiträge
Zufallszahl mit Wiederholungsbedingung
Martin

Hallo zusammen,
ich habe eine Frage an die Excel Profis in diesem Forum.
Ich habe in einem Tabellenblatt eine Tabelle mit 35 Einträgen. In Spalte A ist eine ID, diese geht von 1 bis 35.
Jeder ID ist in Spalte B eine eindeutige Fragennummer zugeordnet und in Spalte C eine konkrete F...
03.05.2020 15:09:49
Thread-ID: 1756430
8 Beiträge
Entdecke relevante Threads

Schau dir verwandte Threads basierend auf dem aktuellen Thema an

Alle relevanten Threads mit Inhaltsvorschau entdecken
Anzeige
Anzeige

Infobox / Tutorial

Zufällige Zeilen in Excel auswählen mit Bedingungen

Schritt-für-Schritt-Anleitung

Um per Zufall Zeilen aus einer Liste in Excel auszuwählen und dabei bestimmte Bedingungen zu berücksichtigen, kannst du folgende VBA-Lösung verwenden:

  1. Öffne Excel und erstelle eine neue Arbeitsmappe oder benutze eine bestehende.

  2. Öffne den VBA-Editor (Alt + F11).

  3. Füge ein neues Modul hinzu:

    • Rechtsklick auf "VBAProject (deine_datei.xlsx)" > Einfügen > Modul.

  4. Kopiere den folgenden Code in das Modul:

    Option Explicit
Sub Staedte()
   Dim Anzahl As Long
   Dim StartZeile As Long, EndZeile As Long, Zufallszeile As Long
   Dim AlteZeile As Long, LetzteZeile As Long
   Dim Zufall As Long
   Dim LngI As Long, LngX As Long, LngY As Long
   Dim Liste(100) As Variant
   Const Prozent = 2
   Randomize

   ' Alte Einträge löschen aus den Spalten D und E
   Range(Cells(2, 4), Cells(Rows.Count, 5)).ClearContents

   ' Städteliste aus Spalte A einlesen
   For LngI = 2 To Cells(Rows.Count, 1).End(xlUp).Row
       If Cells(LngI, 1) <> Cells(LngI - 1, 1) Then
           LngX = LngX + 1
           Liste(LngX) = Cells(LngI, 1)
       End If
   Next

   ' Nach angegebener Prozentzahl Liste zufällig generieren
   For LngY = 1 To LngX
       Anzahl = WorksheetFunction.CountIf(Range("A2:A1201"), Liste(LngY))
       StartZeile = WorksheetFunction.Match(Liste(LngY), Range("A1:A1201"), 0)
       EndZeile = StartZeile + Anzahl - 1
       Zufall = WorksheetFunction.RoundUp(Anzahl * Prozent / 100, 0)
       For LngI = 1 To Zufall
           Zufallszeile = Round(Rnd() * Anzahl, 0) + StartZeile
           If AlteZeile = Zufallszeile Then
               LngI = LngI - 1
           Else
               AlteZeile = Zufallszeile
               LetzteZeile = Cells(Rows.Count, 4).End(xlUp).Row + 1
               Cells(LetzteZeile, 4) = Cells(Zufallszeile, 1)
               Cells(LetzteZeile, 5) = Cells(Zufallszeile, 2)
           End If
       Next
   Next
End Sub

  5. Starte das Skript durch Drücken von F5 oder über das Menü.

Diese Methode nutzt den excel zufallsgenerator mit bedingung, um eine zufällige Auswahl aus einer Liste zu treffen, wobei mindestens 2% jeder Stadt berücksichtigt werden.

Häufige Fehler und Lösungen

  1. Fehler: Falsche Ergebnisse bei wiederholtem Ausführen des Skripts

    • Lösung: Stelle sicher, dass die Daten in der Liste nach Ort sortiert sind, bevor du das Skript ausführst.

  2. Fehler: Zu wenig oder keine Ergebnisse

    • Lösung: Überprüfe, ob die Prozentzahl korrekt gerundet wird. Nutze WorksheetFunction.RoundUp für die Rundung.

  3. Fehler: Adressen werden nicht korrekt gezählt

    • Lösung: Vergewissere dich, dass die Daten in den richtigen Spalten stehen und die richtigen Zellbereiche definiert sind.

Alternative Methoden

Wenn du keine VBA-Lösungen verwenden möchtest, kannst du auch die Funktionen Zufallszahl oder Zufallsbereich in Verbindung mit INDEX und VERGLEICH nutzen, um excel zufällig aus liste auswählen zu können:

  1. Füge eine Hilfsspalte ein, die zufällige Zahlen generiert, z.B. =ZUFALLSZAHL().
  2. Sortiere die Liste nach dieser Hilfsspalte.
  3. Wähle die obersten Zeilen entsprechend deinem Prozentsatz aus.

Praktische Beispiele

Angenommen, du hast eine Liste mit Städten und Adressen:

Stadt Adresse
Berlin Adresse1
Berlin Adresse2
Hamburg Adresse1
Hamburg Adresse2
Köln Adresse1

Wenn du 2% der Adressen pro Stadt zufällig auswählen möchtest, wird die VBA-Lösung dir helfen, eine zufällige Auswahl zu treffen, wobei jede Stadt berücksichtigt wird.

Tipps für Profis

  • Nutze Arrays, um die Leistung zu verbessern, wenn du mit großen Datenmengen arbeitest.
  • Experimentiere mit verschiedenen Prozentwerten, um die besten Ergebnisse für deine Daten zu erzielen.
  • Integriere Validierungsprüfungen, um sicherzustellen, dass die Eingabedaten korrekt sind, bevor du das Skript ausführst.

FAQ: Häufige Fragen

1. Wie kann ich die Zufallsauswahl auf andere Bereiche ausdehnen? Du kannst die Zellbezüge im VBA-Code entsprechend anpassen, um verschiedene Bereiche zu berücksichtigen.

2. Ist es möglich, ohne VBA eine zufällige Auswahl zu treffen? Ja, du kannst die Excel-Funktionen ZUFALLSZAHL oder ZUFALLSBEREICH verwenden, um eine zufällige Auswahl zu treffen, jedoch ist es weniger flexibel als mit VBA.

3. Kann ich die Auswahl anpassen, um 5% oder mehr auszuwählen? Ja, ändere einfach den Wert von Const Prozent = 2 im VBA-Code auf deinen gewünschten Prozentsatz.

Beliebteste Forumthreads (12 Monate)

Jetzt das Excel-Portal bewerten: Deine Stimme zählt!
Anzeige
Anzeige
Entdecke mehr
Finde genau, was du suchst

Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden

Suche nach den besten Antworten
Unsere beliebtesten Threads

Entdecke unsere meistgeklickten Beiträge in der Google Suche

Top 100 Threads jetzt ansehen
Anzeige