2024年4月14日发(作者：)
年会抽奖神器代码
Dim f As Integer
Sub 滚动()
f = 0
Sheets("抽奖首页").Activate
Dim i, j As Integer
Sheets("抽奖首页").Range("B18:E10000").ClearContents
Sheets("抽奖库").Range("E2:E100000").ClearContents
With Sheets("抽奖库")
j = .Range("C100000").End(xlUp).Row
For i = 2 To j
.Range("A" & i) = Rnd()
Next
For i = 2 To j
.Range("B" & i) = (.Range("A" & i), .Range("A2:A" & j))
Next
End With
Dim m As Integer
Do While f = 0
For m = 1 To Sheets("抽奖首页").Range("D14")
Sheets("抽奖首页").Range("C" & (17 + m)) = Sheets("抽奖库").Range("C" &
tween(2, Sheets("抽奖库").Range("C10000").End(xlUp).Row))
Sheets("抽奖首页").Range("D" & (17 + m)) = Sheets("抽奖库").Range("D" &
tween(2, Sheets("抽奖库").Range("C10000").End(xlUp).Row))
Sheets("抽奖首页").Range("E" & (17 + m)) = Sheets("抽奖首页").Range("C14")
Sheets("抽奖首页").Range("B" & (17 + m)) = Sheets("抽奖首页").Range("B" & (17 + m)).Row
- 17
Next
DoEvents
Loop
End Sub
Sub 抽奖()
f = 1
Sheets("抽奖首页").Range("B18:E" & (17 + Sheets("抽奖首页").Range("D14"))).Copy Sheets("
已中奖名单").Range("A" & Sheets("已中奖名单").Range("A100000").End(xlUp).Row + 1)
Dim p, q As Integer
q = Sheets("抽奖库").Range("D20000").End(xlUp).Row
Sheets("抽奖库").Activate
For p = 2 To q
Sheets("抽奖库").Range("E" & p) = (p(Sheets("抽奖库
").Range("D" & p), Sheets("已中奖名单").Range("C1:D20000"), 1, False), 1)
Next
Sheets("抽奖库").Range("A1:E" & q).AutoFilter Field:=5, Criteria1:="<>1"
Sheets("抽奖库").Rows("2:100000").Select
Shift:=xlUp
Sheets("抽奖库").Range("A1").AutoFilter
Sheets("抽奖首页").Activate
End Sub
发布者：admin，转转请注明出处：http://www.yc00.com/news/1713103092a2183549.html
评论列表（0条）