抽奖系统

煖煖

一把小刀闯天下 发表于 2019-6-24 14:39
上个模拟附件就可以了，，，

什么是模拟附件鸭

一把小刀闯天下

煖煖 发表于 2019-6-24 16:49
什么是模拟附件鸭

'新人，咱心有毛竹。直接给你上个附件吧，，，

工作簿1.rar (13.86 KB, 下载次数: 30)

2019-6-24 19:18 上传

点击文件名下载附件

Option Explicit

Sub test()
  Dim arr, i, j, mark, m, n, t
  arr = Range("a2:c" & Cells(Rows.Count, "a").End(xlUp).Row)
  mark = [h1:j3]
  Randomize
  For i = 1 To UBound(mark, 2)
    For j = 1 To mark(2, i)
      m = m + 1
      If m > UBound(arr, 1) Then MsgBox "!": Exit Sub
      n = Int(Rnd * (UBound(arr, 1) - m + 1)) + m
      t = arr(m, 1): arr(m, 1) = arr(n, 1): arr(n, 1) = t
      arr(m, 2) = arr(m, 1): arr(m, 1) = mark(1, i): arr(m, 3) = mark(3, i)
    Next
  Next
  With [c2]
    .Resize(Rows.Count - 1, 3).ClearContents
    .Resize(m, 3) = arr
  End With
End Sub

煖煖

一把小刀闯天下 发表于 2019-6-24 19:21
'新人，咱心有毛竹。直接给你上个附件吧，，，

太厉害了，谢谢