Random Sampling & Auswahl nach Kategorie VBA

Question

Ich versuche, ein Makro auf MS Excel zu schreiben, mit dem ich Stichproben erstellen und zufällige Werte aus diesen Proben für jede Kategorie in den Daten auswählen kann.

Um genauer zu sein, sind die Daten auf zwei Ebenen: Unternehmen und Jahr, wobei jede Zeile eine Peer-Jahres-Beobachtung darstellt. Für jedes Unternehmen haben wir zu einem gegebenen Jahr j eine Anzahl von tatsächlichen Peers.

Ich möchte jedem Unternehmen, aus der gesamten Stichprobe während vieler Jahre, ein zufälliges Unternehmen aus der Liste aller verfügbaren Firmen in diesem bestimmten Jahr zuweisen. Der Trick dabei ist, dass die Anzahl der zu vergebenden Firmen identisch sein sollte mit der Anzahl der tatsächlichen Peers, die ein Unternehmen in diesem Jahr hat. Außerdem sollten die zufällig zugewiesenen Werte von den tatsächlichen Peers der Firma und natürlich von der Firma selbst abweichen.

i   j   k 
1   2006  100 
1   2006  105 
1   2006  110 
2   2006  113 
2   2006  155 
2   2006  200 
2   2006  300 

Zum Beispiel Unternehmen 1 tatsächlichen Peers in Jahr 2006 sind 100, 105 und 110 sind jedoch alle möglichen Firmen zur Verfügung stehen 100, 105, 110, 113, 155, 200 und 300. Das bedeutet, dass ich um 3 zu wählen (weil Unternehmen 1 3 tatsächliche Peers hat) zufällige fiktive Peers aus den 4 Firmen, die in diesem Jahr kein Peer von Peer 1 sind (dh 113, 155, 200 und 300). Wenn ich das gleiche Verfahren für Firma 2 anwende, muss ich 4 zufällige Firmen auswählen, die keine echten Firmen von Firma 2 aus allen möglichen Firmen sind.

Ich hoffe, das war klar.

Ich begann diese Funktion auf MS Excel auszuprobieren, aber ich bin offen für Vorschläge, wenn Sie denken, dass andere Plattformen nützlicher wären.

Ihre Hilfe würde sehr geschätzt werden!

Danke!

Answer 1

Vielen Dank an alle, die meinen Beitrag besucht haben.

Nach einigem anfänglichen Kampf habe ich es geschafft, den Code selbst herauszufinden. Ich poste es unten für jeden, der es brauchen könnte.

Grundsätzlich habe ich den Randomisierungscode von this sanfte Seele, und erweiterte es für meine Bedürfnisse mit paar Flaggen für jede neue Firma und jedes neue Jahr. Hoffe es ist für jeden klar.

Beste

Sub Random_Sampling() 
    ' 
    Dim PeerCount, FirmCount, YearCount As Long 
    Dim Focal_CIK, fiscalYear As Long 
    Const nItemsTotal As Long = 1532 
    Dim rngList As Range 
    Dim FirmYearRange As Range 
    Dim FirmStart, FirmStartRow, YearStartRow As Long 
    Dim ExistingPeers As Range 
    Dim idx() As Long 
    Dim varRandomItems() As Variant 
    Dim i, j, k, m, n As Long 
    Dim iCntr, jCntr As Long 
    Dim booIndexIsUnique As Boolean 

    Set rngList = Sheets("Sheet2").Range("A2").Resize(nItemsTotal, 1) 

    FirmCount = Cells(2, 10).Value 

For k = 1 To FirmCount 

    FirmStart = Application.WorksheetFunction.Match(k, Columns("E"), 0) 
    Focal_CIK = Cells(FirmStart, 1).Value 
    YearCount = Cells(FirmStart, 7).Value 

    For m = 1 To YearCount 

    Set FirmYearRange = Range("H" & FirmStart & ":H200000") 
    YearStartRow = Application.WorksheetFunction.Match(m, FirmYearRange, 0) + FirmStart - 1 
    fiscalYear = Cells(YearStartRow, 3).Value 
    PeerCount = Cells(YearStartRow, 9).Value 
    Set ExistingPeers = Range(Cells(YearStartRow + PeerCount, 2), Cells(YearStartRow + PeerCount, 2)) 

    ReDim idx(1 To PeerCount) 
    ReDim varRandomItems(1 To PeerCount) 

    For i = 1 To PeerCount 

     Do 
      booIndexIsUnique = True ' Innoncent until proven guilty 

      idx(i) = Int(nItemsTotal * Rnd + 1) 

      For j = 1 To i - 1 
       If idx(i) = idx(j) Then 'Is already picked 
        ElseIf idx(i) = Focal_CIK Then 'Is the firm itself 
         booIndexIsUnique = False 'If true, don't pick it 
        Exit For 
       End If 

       For n = 1 To PeerCount 
        If idx(i) = Cells(YearStartRow + n - 1, 2).Value Then 'Is one of the actual peers 
         booIndexIsUnique = False 'If true, don't pick it 
        Exit For 
        Exit For 
       End If 
       Next n 
      Next j 
      If booIndexIsUnique = True Then 
       Exit Do 
      End If 
     Loop 

     varRandomItems(i) = rngList.Cells(idx(i), 1) 

     Rows(YearStartRow + PeerCount).EntireRow.Insert 

     'The order of the columns are very important for the following lines 
     Cells(YearStartRow + PeerCount, 1) = Focal_CIK 
     Cells(YearStartRow + PeerCount, 2) = varRandomItems(i) 
     Cells(YearStartRow + PeerCount, 3) = fiscalYear 
     Cells(YearStartRow + PeerCount, 4) = "0" 

    Next i 

    Next m 

Next k 

End Sub