カテゴリ別ランダムサンプリングと選択VBA

Question

MS Excelでマクロを作成しようとしていますが、ランダムサンプルを作成し、データの各カテゴリのサンプルからランダムな値を選択できます。

より具体的には、データは2つのレベルにあります。会社と年です。ここで、各行は企業年内の観察を表します。各企業iについて、所与の年jにおいて、実際のピア数がある。

私がしたいことは、サンプル全体から、長年にわたり、その特定の年に利用可能なすべての企業のリストからランダムな企業を割り当てることです。そのトリックは、割り当てられる企業の数が、その企業がその年に持っている実際のピアの数と同じでなければならないということです。また、無作為に割り当てられた値は、会社の実際の同僚とはもちろん、会社自体とは異なるはずです。例えば

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

、2006年における企業1の実際のピアはしかし、利用可能なすべての可能な企業は100、105、110、113、155、200および300は100、105および110されているこれは、私が持っていることを意味しその年の企業1のピアではない4社（つまり113,155,200,300）の3社（企業1には実際のピアが3つあるため）を選択する。会社2に同じ手順を適用すると、会社2の実際の同僚ではない4つのランダムな会社を、すべての可能な会社から選ぶ必要があります。

これは明らかです。

私はこの機能をMS Excel上で試してみましたが、他のプラットフォームがより有用であると思うならば、私は提案することができます。

ご協力いただきありがとうございます。

ありがとうございます！

Answer 1

私の投稿にアクセスしたすべての人に感謝します。

最初の苦労の末、私は自分自身でコードを理解することができました。私はそれを必要とするかもしれない誰のためにそれを下に掲示しています。

基本的に私はthis優しい魂によって投稿されたランダム化コードを使用し、それぞれの新しい会社と新しい年ごとにいくつかのフラグを使用して自分のニーズに合わせて拡張しました。誰にとっても分かりやすいことを願っています。

ベスト

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