从一组中选择一个随机数而不在Excel中复制

时间:2019-03-02 21:57:37

标签: excel vba

在Excel中,我试图从一个集合中选择一个不重复的随机数,总是从尚未选择的最大可用数字开始。

Example

这是我想要做的事情,结果表是我想要实现的。基本上,您可以在“选择”列中选择不同的数字。我想用从“选择”列中随机选择的数字填充“结果”列,而无需重复,总是从“选择”列中的最大数字开始,然后从那里开始。

存在“检查”列,以确定将要绘制多少张。如果“校验和”行的总和为1,则该列的结果将始终为0.8,这是从选择中获得的最大抽奖。如果检查行的总和为2,则与该行中值为1的“检查”单元格关联的“结果”单元格将为0.8或0.1-但我希望将其随机抽取为哪个单元格等于0.8和0.1(如果有道理)。

任何基于工作表或VBA的洞察力如何实现这一点将不胜感激。一如既往地感谢您的帮助!

1 个答案:

答案 0 :(得分:0)

可以尝试

Sub RandSel()
Dim Sel As Range, ChkRng As Range, OutRng As Range, RandSel As Double
Dim Sel2 As Range, ChkRng2 As Range, OutRng2 As Range, Cel As Range
Dim Rw As Long, Col As Long, Offs As Long, Sm As Long
RandSel = 0
Set Sel = Range("A2:A6")              ' may change to your requirement
Set ChkRng = Range("E2:I7")           ' may change to your requirement 
Set OutRng = Range("K2:O7")           ' may change to your requirement

For Rw = 1 To OutRng.Rows.Count
Set ChkRng2 = Range(ChkRng(Rw, 1), ChkRng(Rw, ChkRng.Columns.Count))  'set range to the row only to evelte repeatation of value
Set OutRng2 = Range(OutRng(Rw, 1), OutRng(Rw, OutRng.Columns.Count)) 'set range to the row only to evelte repeatation of value
    For Col = 1 To OutRng.Columns.Count
    Sm = Application.WorksheetFunction.Sum(ChkRng2)
        If ChkRng(Rw, Col).Value = 0 Or Sm = 0 Then
        RandSel = 0
        Else
        Set Sel = Range(Sel(1, 1), Sel(Sm, 1))
        idx = WorksheetFunction.RandBetween(1, Sm)
        RandSel = Sel(idx, 1)

        If Col > 1 Then
        Set OutRng2 = Range(OutRng(Rw, 1), OutRng(Rw, Col - 1)) ' set to upto the column in process
        Do While WorksheetFunction.CountIf(OutRng2, RandSel) > 0 ' check only after 1st col
            Set Sel2 = Nothing                                      ' set Sel to range Sel2 - Used value
                For Each Cel In Sel.Cells
                 If Cel.Value <> RandSel Then
                        If Sel2 Is Nothing Then
                        Set Sel2 = Cel
                        Else
                        Set Sel2 = Union(Sel2, Cel)
                        Sm = Sel2.Cells.Count
                        End If
                        End If
                    Next
                    If Sm > 1 Then
                    idx = WorksheetFunction.RandBetween(1, Sm)
                    Else
                    idx = 1
                    End If
                RandSel = Sel2(idx, 1)
            Loop
        End If
    End If
    OutRng(Rw, Col).Value = RandSel
    Next Col
Next Rw
End Sub