Question

我正在尝试在MS Excel上编写宏，这样我就可以创建随机样本，并从数据中每个类别的样本中选择随机值。

更具体地说，数据分为两个级别：公司和年份，其中每一行代表公司年同行观察。对于每个公司我，在给定的年份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.这意味着我有选择3（因为公司1有3个实际同伴）来自4家公司的随机虚构同行，这些公司当年不是公司1的同行（即113,155,200和300）。对于公司2应用相同的程序，我需要从所有可能的公司中选择4个不是公司2的实际同行的随机公司。

我希望这很清楚。

我开始在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

随机抽样＆amp;按类别选择VBA

1 个答案: