VBA/Makro Zufallsdaten mit mehreren Bedingungen zu bekommen

Question

Ich brauche Hilfe von einem anderen Arbeitsblatt Zufallsdaten zu erhalten, um mit spezifischen Bedingungen

Etwas wie folgt aus:

Wenn ich auf eine Schaltfläche klicken oder ein Makro ausführen , Sollte ich 4 random samples for all rows that has AA, 1 random sample for all rows that has BB, 1 random sample for all rows that has CC, 3 random samples for all rows that has DD und 1 random sample for all rows that has EE von rawdata.xlsx "Sheet1" Blatt und fügen Sie es zu tool.xlsm "Random Sample" Blatt.

Alles sollte mit einem Klick geschehen.

Dies ist mein Code so weit. Ich kann nur bestimmte Mengen von Zufallsdaten innerhalb des gesamten Arbeitsblatts erhalten. Ich hoffe, dass jemand diesen Code für mich bearbeiten kann oder den Code gibt, um mir zu helfen und in der Lage zu sein, zu machen, was ich machen will. Vielen Dank im Voraus

Sub CopyRandomRows() 


    Sheets("Random Sample").Select 
     Cells.Select 
     Range("C14").Activate 
     Selection.Delete Shift:=xlUp 


Windows("rawdata.xlsx").Activate 
    Rows("1:1").Select 
    Selection.Copy 
    Application.CutCopyMode = False 
    Selection.Copy 
    Windows("tool.xlsm").Activate 
    Sheets("Random Sample").Select 
    Rows("1:1").Select 
    ActiveSheet.Paste 

    Dim source As Range, target As Range, randCount&, data(), value, r&, rr&, c& 

    'this defines the source to take the data 
    Set source = Workbooks("rawdata.xlsx").Worksheets("Sheet1").Range("A2:L5215") 

    'this defines the target to paste the data 
    Set target = Workbooks("tool.xlsm").Worksheets("Random Sample").Range("A2") 

    'this defines the number of rows to generate based on the input in textbox 
    randCount = 20 
    'this loads the data in an array 
    data = source.value 

    'this shuffles the rows 
    For r = 1 To randCount 
    rr = 1 + Math.Round(VBA.rnd * (UBound(data) - 1)) 
    For c = 1 To UBound(data, 2) 
     value = data(r, c) 
     data(r, c) = data(rr, c) 
     data(rr, c) = value 
    Next 
    Next 

    'this writes the data to the target 
    target.Resize(randCount, UBound(data, 2)) = data 


End Sub 

Answer 1

würde ich, dass auf diese Weise tun:

Option Explicit 

'****************************************************** 
'*** needs reference to Microsoft Scripting Runtime *** 
'****************************************************** 
Sub GetRandomSamples() 
Dim oDicSam As Dictionary 
Dim iCounter As Integer, k As Variant, iRandom As Integer, iRndMin As Integer, iRndMax As Integer, j As Integer 
Dim source As Worksheet, target As Worksheet 

On Error GoTo Err_GetRandomSamples 

Set source = ThisWorkbook.Worksheets(1) 
Set target = ThisWorkbook.Worksheets(2) 

'define the range for randomizing 
iRndMin = 1 
iRndMax = 500 

'define the numbers of records for each column  
Set oDicSam = New Dictionary 
oDicSam.Add "AA", 4 
oDicSam.Add "BB", 1 
oDicSam.Add "CC", 1 
oDicSam.Add "DD", 3 
oDicSam.Add "EE", 1 

j = 1 
Randomize 
For Each k In oDicSam.Keys 
    For iCounter = 1 To oDicSam.Item(k) 
     iRandom = Int((iRndMax - iRndMin + 1) * Rnd + iRndMin) 
     'MsgBox "Random number for '" & k & "' is: " & iRandom, vbInformation, "Randomizing - " & iCounter 
     source.Range(k & iRandom).Copy target.Range("A" & j) 
     j = j + 1 
    Next 
Next 

Exit_GetRandomSamples: 
    On Error Resume Next 
    Set source = Nothing 
    Set target = Nothing 
    Set oDicSam = Nothing 
    Exit Sub 


Err_GetRandomSamples: 
    MsgBox Err.Description, vbExclamation, Err.Number 
    Resume Exit_GetRandomSamples 

End Sub 

Wie Sie sehen, ich bin Dictionary Objekt verwendet, die bei der Festlegung der Anzahl der Proben hilfreich ist für jede Spalte zu erhalten . Dann verwende ich thw Schleifen. Der erste durchläuft die Sammlung von Schlüsseln und der zweite verwendet einen Wert (Gegenstand), der mit diesem Schlüssel in Beziehung steht.

Fühlen Sie sich frei, den Code zu Ihren Bedürfnissen zu ändern.