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

我不熟悉使用macros的，但我认为，我想要执行的是最好的macros处理。 所以我可以使用你所有的input！

我有这些标题;

身份证标签笔性别体重等级范围内

有450行数据。 根据权重数据的分布，我在其他两列（类和数字）中我想要在每个类中select的行数。 所选行在“内部范围”栏中必须具有“是”的值。

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

我希望你有一个build议如何完成这个行动！

Answer 1

您可以尝试以下操作，您将需要添加对Microsoft脚本运行时库的引用：

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 

对不起，如果有一些错误或错别字，我从我的手机写。