单次抽多个奖，不重复

aoni303

刚学不久VBA,公司年会抽奖觉得挺好玩，自己摸索如何实现，定义了一个函数，n 为单次收取的中奖数量，m 为变量控制 不同奖项的输出，如下

Function chouqu(n As Long, m As Integer)

Dim i As Long
Dim j As Long
Dim k As Long
Dim zj As String



'n = InputBox("?????????н???????,????齱?????:" & Sheets("test").Range("a65536").End(xlUp).Row)


For i = 1 To n

    If n <= 0 Or n > Sheets("test").Range("a65536").End(xlUp).Row Then
      MsgBox ("??????????????????")
      Exit For
      End If
Sheets("test").Range("b" & i) = Sheets("test").Application.WorksheetFunction.Index(Sheets("test").Range("a1:a" & Sheets("test").Range("a65536").End(xlUp).Row), Sheets("test").Application.WorksheetFunction.RandBetween(1, Sheets("test").Range("a65536").End(xlUp).Row))


zj = Sheets("test").Range("b" & i)

Sheets("test").Cells(i, m + 3).Value = zj


   
    For j = 1 To Sheets("test").Range("a65536").End(xlUp).Row - 1

       If Sheets("test").Range("a" & j + 1).Value = zj Then
                         k = j + 1
                        ' Sheet3.Range("g" & j + 1) = k
                         Exit For
         
       End If
    Next

   
     For k = j + 1 To Sheets("test").Range("a65536").End(xlUp).Row - 1
   
        Sheets("test").Range("a" & k) = Sheets("test").Range("a" & k + 1)
    Next
   
    Sheets("test").Range("a" & Sheets("test").Range("a65536").End(xlUp).Row) = ""

Next
Sheets("test").Range("b1:b" & n).Clear
MsgBox ("????н???")
End Function

aoni303

欢迎高手指导