Private Declare PtrSafe Sub Sleep Lib "kernel32"(ByVal dwMilliseconds As Long)
Option Base 1
Public 行1, 列1, 行, 列
Private Sub CommandButton1_Click()
Sheet1.Activate
If CommandButton1.Caption ="停!" Then
CommandButton1.Caption ="开始"
Exit Sub
Else
CommandButton1.Caption ="停!"
行 =1
列 =1
行1=1
列1=1
End If
行数 = Val(MultiPage1.page2.TextBox1.Value)
列数 = Val(MultiPage1.page2.TextBox2.Value)
间隔 = Val(MultiPage1.page2.TextBox3.Value)
重复 = MultiPage1.page2.CheckBox1.Value
记录行 = Sheet2.Range("M65536").End(xlUp).Row
Dim arr()
ReDim arr(行数, 列数)
'将可抽单元格值,填入数组,以加快速度
For m =1 To 行数
For n =1 To 列数
arr(m, n)= Cells(m, n)
If Cells(m, n).Interior.Color =65535 And 重复 =False Then
arr(m, n)=""
End If
Next n
Next m
Do While CommandButton1.Caption ="停!"
行 = Int(行数 * Rnd +1)
列 = Int(列数 * Rnd +1)
If arr(行, 列)<>"" Then
'恢复上一单元格底色
Cells(行1, 列1).Select
m = 行1
n = 列1
If Cells(m, n).Interior.Color <>65535 Then '防止A1被选中后又被清除
If ((m Mod 2=0 And n Mod 2=0) Or (m Mod 2=1 And n Mod 2=1)) Then
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade =-0.149998474074526.PatternTintAndShade =0
End With
Else
With Selection.Interior
.Pattern = xlNone
.TintAndShade =0.PatternTintAndShade =0
End With
End If
End If
'设置在选单元格为蓝色
Cells(行, 列).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color =15773696.TintAndShade =0.PatternTintAndShade =0
End With
Label3.Caption = arr(行, 列)
Sleep 间隔
DoEvents
If CommandButton1.Caption ="开始" Then
'恢复上一单元格底色
m = 行1
n = 列1
If Cells(m, n).Interior.Color <>65535 Then '防止A1被选中后又被清除
If ((m Mod 2=0 And n Mod 2=0) Or (m Mod 2=1 And n Mod 2=1)) Then
Cells(行1, 列1).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade =-0.149998474074526.PatternTintAndShade =0
End With
End If
End If
'设置选中单元格为黄色
Cells(行, 列).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color =65535.TintAndShade =0.PatternTintAndShade =0
End With
'将结果记录到名单表K列
记录行 = 记录行 +1
With Sheet2
If .Cells(记录行,11)="" Then
.Cells(记录行,11)= Val(.Cells(记录行 -1,11))+1
End If
.Cells(记录行,12)= Now
.Cells(记录行,13)= arr(行, 列)
End With
End If
行1= 行
列1= 列
End If
Loop
End Sub
Private Sub CommandButton2_Click()
Application.ScreenUpdating =False
Sheet1.Activate
Cells.Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText =True.Orientation =0.AddIndent =False.IndentLevel =0.ShrinkToFit =False.ReadingOrder = xlContext
.MergeCells =False
End With
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
Selection.Borders(xlEdgeTop).LineStyle = xlNone
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
With Selection.Interior
.Pattern = xlNone
.TintAndShade =0.PatternTintAndShade =0
End With
行数 = TextBox1.Value
列数 = TextBox2.Value
For m =1 To 行数
For n =1 To 列数
If (m Mod 2=0 And n Mod 2=0) Or (m Mod 2=1 And n Mod 2=1) Then
With Cells(m, n).Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade =-0.149998474074526.PatternTintAndShade =0
End With
End If
Next n
Next m
Range("w3").Select
Application.ScreenUpdating =True
End Sub
Private Sub CommandButton3_Click()
Application.ScreenUpdating =False
Application.EnableEvents =False
Sheet1.Activate
Cells.ClearContents
行数 = Val(MultiPage1.page2.TextBox1.Value)
列数 = Val(MultiPage1.page2.TextBox2.Value)
行 =1
列 =1
With Sheet2
For m =2 To Sheet2.UsedRange.Rows.Count
For n =1 To 10
If .Cells(m, n)<>"" Then
Cells(行, 列)=.Cells(m, n)
行 = 行 +1
If 行 > 行数 Then
行 =1
列 = 列 +1
If 列 > 列数 And Application.CountA(Sheet2.Range("a:j"))-1> 行数 * 列数 Then
MsgBox "名单个数超过指定行列所能容纳的总数!"
Exit Sub
End If
End If
End If
Next n
Next m
End With
Application.ScreenUpdating =True
Application.EnableEvents =True
MsgBox "名单已填写完成!"
End Sub
Private Sub MultiPage1_Change()
End Sub
Private Sub UserForm_Initialize()
MultiPage1.page2.TextBox1.Value =6
MultiPage1.page2.TextBox2.Value =10
MultiPage1.page2.TextBox3.Value =50
MultiPage1.page2.CheckBox1.Value =False
MultiPage1.page1.Label3.Caption ="中奖人"
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
Cancel =True
End Sub
'Private Sub CommandButton1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
' If KeyAscii =32 Then
' Call CommandButton1_Click
' ElseIf KeyAscii =13 Then
' Call CommandButton1_Click
' End If
'End Sub