按类别随机抽样和选择 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

例如，公司 1 在 2006 年的实际同行是 100、105 和 110。但是，所有可能的公司都是 100、105、110、113、155、200 和 300。这意味着我必须 select 3（因为公司 1 有 3 个实际同行）来自当年不是公司 1 同行的 4 家公司的随机虚构同行（即 113、155、200 和 300）。对公司 2 应用相同的程序，我需要 select 4 个随机公司，这些公司不是来自所有可能公司的公司 2 的实际同行。

我希望这是清楚的。

我开始在 MS Excel 上试用此功能，但如果您认为其他平台会更有用，我愿意听取建议。

非常感谢您的帮助！

谢谢！

Answer 1

非常感谢所有访问过我的 post 的人。

经过一些初步的努力，我设法自己弄清楚了代码。我在下面 post 为任何可能需要它的人提供它。

基本上我使用了 post 由 this gentle soul 编写的随机化代码，并根据我的需要为每个新公司和每个新年使用几个标志来增强它。希望大家清楚。

最佳

    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

按类别随机抽样和选择 VBA

Random Sampling & Selection by Category VBA

excel

vba

random-sample