如何用excel的vba做一个抽签命令,要能够控制它最后停在哪,即抽签结果
2个回答
展开全部
下面的例子是随机抽取数字1至3,并根据抽取到的数字选择对应的单元格A1至A3,你可以根据实际需要更改抽取数的范围和更改选取的单元格。Public
Sub
RndNum1_3()
Dim
N
As
Long
Randomize
N
=
Int(3
*
Rnd
+
1)
抽取随机数1⑶
Range(A
根据抽取结果,选订单元格A1至A3中的1个End
Sub
Sub
RndNum1_3()
Dim
N
As
Long
Randomize
N
=
Int(3
*
Rnd
+
1)
抽取随机数1⑶
Range(A
根据抽取结果,选订单元格A1至A3中的1个End
Sub
已赞过
已踩过<
评论
收起
你对这个回答的评价是?
展开全部
问题描述得不清不楚的话 再急人家也不知道
这是我做的 不知道对你有用没
Sub 开始抽签()
For i = 9 To 0 Step -1
wt = 1
Do While wt > 0.1
ra = Int(Rnd() * 10)
Select Case ra
Case 0
Cells(1, 2).Select
Case 1
Cells(1, 1).Select
Case 2
Cells(2, 1).Select
Case 3
Cells(3, 1).Select
Case 4
Cells(3, 2).Select
Case 5
Cells(3, 3).Select
Case 6
Cells(3, 4).Select
Case 7
Cells(2, 4).Select
Case 8
Cells(1, 4).Select
Case 9
Cells(1, 3).Select
End Select
Application.Wait (Now + TimeValue("0:00:01") * wt)
wt = wt * 0.8
Loop
c = 11 - i
Cells(c, 6) = "第" & (10 - i) & "次抽签结果"
Cells(c, 7) = i
MsgBox "第" & (10 - i) & "次抽签结果为: " & i
Next
End Sub
Sub 新建抽签表()
'
' Macro2 Macro
'
'
Sheets.Add After:=Sheets(Sheets.Count)
Cells.Select
Selection.RowHeight = 48
Range("A1").Select
ActiveCell.FormulaR1C1 = "1"
Range("A2").Select
ActiveCell.FormulaR1C1 = "2"
Range("A3").Select
ActiveCell.FormulaR1C1 = "3"
Range("B3").Select
ActiveCell.FormulaR1C1 = "4"
Range("C3").Select
ActiveCell.FormulaR1C1 = "5"
Range("D3").Select
ActiveCell.FormulaR1C1 = "6"
Range("D2").Select
ActiveCell.FormulaR1C1 = "7"
Range("D1").Select
ActiveCell.FormulaR1C1 = "8"
Range("C1").Select
ActiveCell.FormulaR1C1 = "9"
Range("B1").Select
ActiveCell.FormulaR1C1 = "0"
Range("A1:D3").Select
With Selection.Font
.Name = "Arial Unicode MS"
.Size = 36
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
Selection.Font.Bold = True
With Selection.Font
.Color = -16776961
.TintAndShade = 0
End With
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 49407
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Range("B2:C2").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Range("A1:D3").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Range("F1").Select
ActiveCell.FormulaR1C1 = "抽签结果"
With ActiveCell.Characters(Start:=1, Length:=4).Font
.Name = "宋体"
.FontStyle = "常规"
.Size = 12
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
Range("F2").Select
Sheets("Sheet3").Select
ActiveSheet.Buttons.Add(219, 5.25, 45, 133.5).Select
Selection.OnAction = "Sheet3.开始抽签"
ActiveSheet.Shapes("Button 1").Select
Selection.Characters.Text = "开始"
With Selection.Characters(Start:=1, Length:=2).Font
.Name = "宋体"
.FontStyle = "常规"
.Size = 12
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
Range("G1").Select
End Sub
这是我做的 不知道对你有用没
Sub 开始抽签()
For i = 9 To 0 Step -1
wt = 1
Do While wt > 0.1
ra = Int(Rnd() * 10)
Select Case ra
Case 0
Cells(1, 2).Select
Case 1
Cells(1, 1).Select
Case 2
Cells(2, 1).Select
Case 3
Cells(3, 1).Select
Case 4
Cells(3, 2).Select
Case 5
Cells(3, 3).Select
Case 6
Cells(3, 4).Select
Case 7
Cells(2, 4).Select
Case 8
Cells(1, 4).Select
Case 9
Cells(1, 3).Select
End Select
Application.Wait (Now + TimeValue("0:00:01") * wt)
wt = wt * 0.8
Loop
c = 11 - i
Cells(c, 6) = "第" & (10 - i) & "次抽签结果"
Cells(c, 7) = i
MsgBox "第" & (10 - i) & "次抽签结果为: " & i
Next
End Sub
Sub 新建抽签表()
'
' Macro2 Macro
'
'
Sheets.Add After:=Sheets(Sheets.Count)
Cells.Select
Selection.RowHeight = 48
Range("A1").Select
ActiveCell.FormulaR1C1 = "1"
Range("A2").Select
ActiveCell.FormulaR1C1 = "2"
Range("A3").Select
ActiveCell.FormulaR1C1 = "3"
Range("B3").Select
ActiveCell.FormulaR1C1 = "4"
Range("C3").Select
ActiveCell.FormulaR1C1 = "5"
Range("D3").Select
ActiveCell.FormulaR1C1 = "6"
Range("D2").Select
ActiveCell.FormulaR1C1 = "7"
Range("D1").Select
ActiveCell.FormulaR1C1 = "8"
Range("C1").Select
ActiveCell.FormulaR1C1 = "9"
Range("B1").Select
ActiveCell.FormulaR1C1 = "0"
Range("A1:D3").Select
With Selection.Font
.Name = "Arial Unicode MS"
.Size = 36
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
Selection.Font.Bold = True
With Selection.Font
.Color = -16776961
.TintAndShade = 0
End With
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 49407
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Range("B2:C2").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Range("A1:D3").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Range("F1").Select
ActiveCell.FormulaR1C1 = "抽签结果"
With ActiveCell.Characters(Start:=1, Length:=4).Font
.Name = "宋体"
.FontStyle = "常规"
.Size = 12
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
Range("F2").Select
Sheets("Sheet3").Select
ActiveSheet.Buttons.Add(219, 5.25, 45, 133.5).Select
Selection.OnAction = "Sheet3.开始抽签"
ActiveSheet.Shapes("Button 1").Select
Selection.Characters.Text = "开始"
With Selection.Characters(Start:=1, Length:=2).Font
.Name = "宋体"
.FontStyle = "常规"
.Size = 12
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
Range("G1").Select
End Sub
本回答被提问者采纳
已赞过
已踩过<
评论
收起
你对这个回答的评价是?
推荐律师服务:
若未解决您的问题,请您详细描述您的问题,通过百度律临进行免费专业咨询