抽奖系统

煖煖

Private Sub CommandButton1_Click()
Dim rng As Range
Range("B10").Value = Index(Range("a1:a10"), randbetween (1, 10))
End Sub
哪位大佬能帮我改改

煖煖

求抽奖系统程序

不知道为什么

论坛搜索类似的帖子还是比较多的

煖煖

不知道为什么 发表于 2019-6-24 14:02
论坛搜索类似的帖子还是比较多的

在哪儿搜索呀，刚注册，还不知道怎么用，嘻嘻

不知道为什么

煖煖 发表于 2019-6-24 14:13
在哪儿搜索呀，刚注册，还不知道怎么用，嘻嘻

w609053988

你想要什么样的效果？

一把小刀闯天下

Option Explicit

Sub test()
  Dim arr, i, j, mark, m, n, t
'  -----------这段注释掉，是给你看的
  ReDim arr(1 To 30, 1 To 1)
  For i = 1 To UBound(arr, 1)
    arr(i, 1) = i
  Next
  [a1].Resize(UBound(arr, 1)) = arr
  '------------
  mark = Split("一等奖,1,二等奖,2,三等奖,4", ",")
  arr = [a1].CurrentRegion.Resize(, 2)
  For i = 0 To UBound(mark) Step 2
    For j = 1 To mark(i + 1)
      m = m + 1
      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(i)
    Next
  Next
  With [c1]
    .Resize(Rows.Count, 2).ClearContents
    .Resize(m, 2) = arr
  End With
End Sub

煖煖

w609053988 发表于 2019-6-24 14:21
你想要什么样的效果？

最简易的，同时抽人和奖品

煖煖

一把小刀闯天下 发表于 2019-6-24 14:22
Option Explicit

Sub test()

大神，蟹蟹，可以加个好友请教一下吗

一把小刀闯天下

煖煖 发表于 2019-6-24 14:36
大神，蟹蟹，可以加个好友请教一下吗

上个模拟附件就可以了，，，