我不熟悉使用宏,但我认为我最擅长表现的是用宏来处理。所以我可以使用你可能拥有的所有输入!
我有这些标题;
ID标签笔性别重量等级内部范围
拥有450行数据。根据权重数据的分布,我在其他两列(类和数字)中有我想在每个类中选择的行数。所选行的“内部范围”列中的值必须为“是”。
我想根据每个类所需的数量随机选择行,并将这些行复制到新工作表中。它在新表中总计最多30行。
我希望你有一个建议如何完成这个动作!
答案 0 :(得分:0)
can you try the following, you will need to add a reference to Microsoft Scripting Runtime library:
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
Sorry if there are some errors or typos, I wrote from my mobile phone.