VBA - 如何从一列中随机选择 10% 的行，确保它们不同并将 Y 放在 B 列中？

Posted 2023-03-29

【中文标题】VBA - 如何从一列中随机选择 10% 的行，确保它们不同并将 Y 放在 B 列中？

【英文标题】：VBA - How do I randomly select 10% of rows from a column, ensuring they are different and put a Y in column B?

【发布时间】：2021-10-30 06:12:28

【问题描述】：

我希望随机选择 10% 的由不同用户完成的任务（“发起人”P 列），并在 B 列中放置一个 Y，以便检查员对工作进行 QC。如果 10% 不是整数，那么我需要四舍五入，即 0.8 需要 1 行，1.3 需要 2 行。

我是编码新手，我已经能够添加代码来过滤行以在 P 列中显示所需的日期和“发起者”，然后将此范围命名为“用户名”。我不知道如何编码来选择随机的 10%。我已将我正在努力解决的部分更改为下面的粗体。

Sub randomSelection()

Dim dt As Date
dt = "20/08/2021"


Dim lRow As Long


'Format date
    Range("J:J").Select
    Selection.NumberFormat = "dd/mm/yyyy"
    
 'Select User Grogu

    ActiveSheet.Range("$A$1:$W$10000").AutoFilter 10, Criteria1:="=" & dt
    ActiveSheet.Range("$A$1:$W$10000").AutoFilter Field:=16, Criteria1:= _
        "SW\Grogu"
        
'Name range "userNames"
  With ActiveSheet
  
  lRow = .Cells(Rows.Count, 16).End(xlUp).Row
  If lRow < 3 Then Exit Sub
  
  .Cells(1, 16).Offset(1, 0).Resize(lRow - 1).SpecialCells(xlCellTypeVisible).Select
  End With

 Selection.Name = "userNames"
 
**'Randomly select 10% of rows from originator and put a Y in column B**
 
'remove all defined names

    On Error Resume Next
    ActiveWorkbook.Names("userNames").Delete

 'Select User Finn

    ActiveSheet.Range("$A$1:$W$10000").AutoFilter 10, Criteria1:="=" & dt
    ActiveSheet.Range("$A$1:$W$10000").AutoFilter Field:=16, Criteria1:= _
        "SW\Finn"
        
'Name range "userNames"
  With ActiveSheet
  
  lRow = .Cells(Rows.Count, 16).End(xlUp).Row
  If lRow < 3 Then Exit Sub
  
  .Cells(1, 16).Offset(1, 0).Resize(lRow - 1).SpecialCells(xlCellTypeVisible).Select
  End With

 Selection.Name = "userNames"
 
'remove all defined names

    On Error Resume Next
    ActiveWorkbook.Names("userNames").Delete
    
    'Formate Date back
    Range("J:J").Select
    Selection.NumberFormat = "yyyy-mm-dd"

End Sub

【问题讨论】：

如果可能，首先在工作表中的每一行添加=RAND()，然后按该列排序。这将为您提供更简单的选择方法。

定义的名称用于不同的东西。相反，您应该使用变量来创建对范围的引用：Dim rg As Range: Set rg = ActiveSheet.Cells(1, 16).Offset(1, 0).Resize(lRow - 1).SpecialCells(xlCellTypeVisible)。现在你可以做 Dim cCount As Long: cCount = Int(rg.Cells.Count / 10): If rg.Cells.count Mod 10 > 0 Then cCount = cCount + 1 。现在您可以继续使用函数here 来解决“随机业务”。了解如何避免 Select 和任何形式的 Active...

如VBasic2008所述，请阅读answer，了解如何避免使用Select。

【参考方案1】：

我有一些空闲时间，编写了一个示例程序，它复制定义的一组行的 10%，然后将其粘贴到不同的工作表中。我添加了一些 cmets 来帮助解释每个部分的目标。

Sub Example()
    'Define the Start and End of the data range
    Const STARTROW As Long = 1
    Dim LastRow As Long
    LastRow = Sheet1.Cells(Sheet1.Rows.Count, 1).End(xlUp).Row
    
    'Create an Array - Length = Number of Rows in the data
    Dim RowArr() As Long
    ReDim RowArr(STARTROW To LastRow)
    
    'Fill the Array - Each element is a row #
    Dim i As Long
    For i = LBound(RowArr) To UBound(RowArr)
        RowArr(i) = i
    Next i
    
    'Shuffle the Row #'s within the Array
    Randomize
    Dim tmp As Long, RndNum As Long
    For i = LBound(RowArr) To UBound(RowArr)
        RndNum = WorksheetFunction.Floor((UBound(RowArr) - LBound(RowArr) + 1) * Rnd, 1) + LBound(RowArr)
        tmp = RowArr(i)
        RowArr(i) = RowArr(RndNum)
        RowArr(RndNum) = tmp
    Next i
    
    'Calculate the number of rows to divvy up
    Const LIMIT As Double = 0.1 '10%
    Dim Size As Long
    Size = WorksheetFunction.Ceiling((UBound(RowArr) - LBound(RowArr) + 1) * LIMIT, 1)
    If Size > UBound(RowArr) Then Size = UBound(RowArr)
    
    'Collect the chosen rows into a range
    Dim TargetRows As Range
    For i = LBound(RowArr) To LBound(RowArr) + Size
        If TargetRows Is Nothing Then
            Set TargetRows = Sheet1.Rows(RowArr(i))
        Else
            Set TargetRows = Union(TargetRows, Sheet1.Rows(RowArr(i)))
        End If
    Next i
    
    'Define the Output Location
    Dim OutPutRange As Range
    Set OutPutRange = Sheet2.Cells(1, 1) 'Top Left Corner
    
    'Copy the randomly chosen rows to the output location
    TargetRows.Copy Destination:=OutPutRange.Resize(TargetRows.Rows.Count).EntireRow
    
End Sub

【讨论】：

我不是一个数学家，所以我不知道我的随机数洗牌是否有偏见。但在我的简短测试中，它显得足够随机。