首页 > 解决方案 > VBA:根据条件选择随机单元格

问题描述

我有 100 个不同的客户,只有 3 种类型(A、B 或 C)。我想(随机)选择 3 个 A 型客户端、2 个 B 型客户端和 30 个 C 型客户端 - 我们可以在 C 列中添加“y”。

在此处输入图像描述

不知道如何从这里开始 - 感谢您的任何提示。

标签: excelvbarandom

解决方案


使用字典对每种类型进行计数并继续随机选择行,直到所有计数都为零。

Option Explicit

Sub pick()

    Const LIMIT = 1000000 ' limit iterations to solve

    Dim wb As Workbook, ws As Worksheet
    Dim lastrow As Long
    Dim dict As Object, key, bLoop As Boolean
    Dim n As Long, x As Long, sType As String

    Set dict = CreateObject("Scripting.Dictionary")
    dict.Add "A", 3
    dict.Add "B", 2
    dict.Add "C", 30

    Set wb = ThisWorkbook
    Set ws = wb.Sheets("Sheet1")
    bLoop = True
    With ws
        lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
        .Range("C2:C" & lastrow).Cells.Clear
        Do While bLoop

            ' select random row
            x = lastrow * Rnd() + 1
            sType = Trim(.Cells(x, "B"))

            ' check if needed
            If Len(.Cells(x, "C")) = 0 And dict(sType) > 0 Then
                .Cells(x, "C") = "Y"
                dict(sType) = dict(sType) - 1
                
                ' check if finished
                bLoop = False
                For Each key In dict
                    If dict(key) > 0 Then bLoop = True
                Next
            End If

            ' avoid infinite loop
            n = n + 1
            If n > LIMIT Then
               For Each key In dict.keys
                   Debug.Print key, dict(key)
               Next
               MsgBox "Too many iterations to solve", vbCritical, "limit=" & LIMIT
               Exit Sub
            End If
         Loop
    End With
    MsgBox "Done in " & n & " iterations", vbInformation
End Sub

推荐阅读