[vba] Collection을 활용한 중복값 없이 랜덤 추출하기

728x90

Sub RndSeat()
    Dim i As Integer, n As Integer, max As Integer, count As Integer
    Dim V As Variant, x As New Collection
    max = Val([D2]) * Val([F2])
    i = Cells(Rows.count, "L").End(3).Row
    If (i - 3) < max Then MsgBox "추출할 수 있는 수량을 초과했습니다.": End
    Do While x.count < max
        Randomize: xAdd x, Int((i - 4 + 1) * Rnd + 4)
    Loop
    [D4].Resize([D4].CurrentRegion.Rows.count, 3).ClearContents
    Application.ScreenUpdating = False
    For i = 4 To Cells(Rows.count, "C").End(3).Row Step 10
        For n = 1 To Val([D2])
            count = count + 1: If x.count < count Then GoTo WorkEnd
            Cells(i + n - 1, 4).Resize(, 3).value = Cells(x.Item(count), "L").Resize(, 3).value
        Next
    Next
WorkEnd:
Application.ScreenUpdating = True
    MsgBox "완료!!"
End Sub
 
Function xAdd(ByRef x As Collection, ByVal value As String) As Boolean
    On Error GoTo ErrPass
    x.Add value, value
    xAdd = True
ErrPass:
End Function