根据类别从列表中随机选择一个项目，根据不同的数字重复次数

Question

我不熟悉使用宏，但我认为我希望 excel 执行的操作最好使用宏来处理。所以我可以使用你可能有的所有输入！

我有这些标题；

ID 标签笔性别重量等级范围内

有 450 行数据。根据权重数据的分布，我在另外两列（类和数字）中有我想在每个类中选择的行数。所选行在“范围内”列中的值必须为“是”。

我想根据每个班级所需的数量随机选择行，并将这些行复制到新工作表中。它在新工作表中总计最多 30 行。

希望您对如何完成此操作有建议！

Answer 1

您可以尝试以下方法吗，您需要添加对 Microsoft Scripting Runtime 库的引用：

Const rowCount = 450
Public Sub copyRows() 
    Dim i As Integer
    Dim j As Integer 
    Dim classes As Scripting.Dictionary
    Dim source As Worksheet
    Dim colNumber As Integer
    Dim colClassName as Integer
    Dim colInsideRange As Integer
    Dim allSelected As Boolean
    Dim randomRow as Integer
    Dim sumRemaining as Integer
    allSelected = False
    Set source = Worksheets("YourWorksheetName")
    colClassName = 6 'this is the column number where class names are entered. I am assuming 6
    colNumber = 7 'this is the column number where number of rows to be selected are entered. I am assuming 7
    colInsideRange  = 8 'this is the column number where "Inside Range" values are entered. I am assuming 9
    For i = 2 to rowCount + 1 'assuming you have a header row
        classes(CStr(source.Cells(i, colClassName))) = CInt(source.cells(i, colNumber)
    Next i
    Do until allSelected 
        Randomize
        randomRow = Int ((Rnd * 450) + 2) 'assuming you have a header row, + 1 if you don't
        If classes(CStr(source.Cells(randomRow, colClassName))) = 0 Then
            With classes
                sumRemaining = 0
                For j = 1 to .Count - 1
                    sumRemaining = sumRemaining + .Items(j)
                    If sumRemaining > 0 Then Exit For
                Next j
                allSelected = (sumRemaining = 0)
            End With
        Else
            source.Cells(randomRow, colInsideRange) = "Yes"
            classes(CStr(source.Cells(randomRow, colClassName))) = classes(CStr(source.Cells(randomRow, colClassName))) - 1
        End If
    Loop
    'Enter your code to copy rows with "Inside Range" = "Yes"
End Sub

抱歉，如果有一些错误或拼写错误，我是用手机写的。