怎樣用EXCEL制作彩

我們有時要花一些心思去研究號碼，今天小編就和大師分享一下如何利用EXCEL來建造號碼生當作器，供大師參考。

東西/原料

EXCEL

方式/步調

1
籌辦工作：在新建的EXCEL工作表中定名兩個工作表別離為：號碼和選號——按圖所示設置選號表格的屬性（白底無邊框）——插入一個文本框輸入選號文字。
2
起首打開VBA編纂器（同時按alt+F11)——點擊插入——窗體，把窗體拖沓變大一些并點竄窗體的caption屬性，如點竄當作“號碼生當作器”——插入框架并點竄窗體的caption屬性，如根基參數——接著在第一個框架插入標簽和文字框或者選項按鈕。插入的窗體內容就按最張結果圖那樣插入。
3
第二，設置根基參數中每個文本框輸入值的VBA代碼：
Private Sub spbMax_Change()
'最大號碼
txtMax.Value = spbMax.Value
'設置幸運號和解除號的規模
設置號碼規模
End Sub
Private Sub spbMzhs_Change()
'每注號數
txtMzhs.Value = spbMzhs.Value
End Sub
Private Sub spbScs_Change()
'生當作注數
txtScs.Value = spbScs.Value
End Sub
4
第三，設置幸運號框架中選項按鈕值的輸入VBA代碼：
Private Sub spbXyh1_Change()
'幸運號碼1
txtXyh1.Value = spbXyh1.Value
End Sub
Private Sub spbXyh2_Change()
'幸運號碼2
txtXyh2.Value = spbXyh2.Value
End Sub
Private Sub spbXyh3_Change()
'幸運號碼3
txtXyh3.Value = spbXyh3.Value
End Sub
5
第四，設置解除號碼文本框的數值輸入VBA代碼：
Private Sub spbPch1_Change()
'解除號碼1
txtPch1.Value = spbPch1.Value
End Sub
Private Sub spbPch2_Change()
'解除號碼2
txtPch2.Value = spbPch2.Value
End Sub
Private Sub spbPch3_Change()
'解除號碼3
txtPch3.Value = spbPch3.Value
End Sub
6
第五，設置文本框數據是否合適要求及設置號碼規模的VBA代碼：
Private Sub txtMax_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
'判定文本框內的數據是否符號要求
If txtMax.Value > spbMax.Max Then
txtMax.Value = spbMax.Max
ElseIf txtMax.Value < spbMax.Min Then
txtMax.Value = spbMax.Min
End If
'設置幸運號和解除號的規模
設置號碼規模
End Sub
Private Sub txtMzhs_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
If txtMzhs.Value > spbMzhs.Max Then
txtMzhs.Value = spbMzhs.Max
ElseIf txtMzhs.Value < spbMzhs.Min Then
txtMzhs.Value = spbMzhs.Min
End If
End Sub
Private Sub txtPch1_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
If txtPch1.Value > spbPch1.Max Then
txtPch1.Value = spbPch1.Max
ElseIf txtPch1.Value < spbPch1.Min Then
txtPch1.Value = spbPch1.Min
End If
End Sub
Private Sub txtPch2_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
If txtPch2.Value > spbPch2.Max Then
txtPch2.Value = spbPch2.Max
ElseIf txtPch2.Value < spbPch2.Min Then
txtPch2.Value = spbPch2.Min
End If
End Sub
Private Sub txtPch3_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
If txtPch3.Value > spbPch3.Max Then
txtPch3.Value = spbPch3.Max
ElseIf txtPch3.Value < spbPch3.Min Then
txtPch3.Value = spbPch3.Min
End If
End Sub
Private Sub txtScs_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
If txtScs.Value > spbScs.Max Then
txtScs.Value = spbScs.Max
ElseIf txtScs.Value < spbScs.Min Then
txtScs.Value = spbScs.Min
End If
End Sub
Private Sub txtXyh1_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
If txtXyh1.Value > spbXyh1.Max Then
txtXyh1.Value = spbXyh1.Max
ElseIf txtXyh1.Value < spbXyh1.Min Then
txtXyh1.Value = spbXyh1.Min
End If
End Sub
Private Sub txtXyh2_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
If txtXyh2.Value > spbXyh2.Max Then
txtXyh2.Value = spbXyh2.Max
ElseIf txtXyh2.Value < spbXyh1.Min Then
txtXyh2.Value = spbXyh2.Min
End If
End Sub
Private Sub txtXyh3_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
If txtXyh3.Value > spbXyh3.Max Then
txtXyh3.Value = spbXyh3.Max
ElseIf txtXyh3.Value < spbXyh3.Min Then
txtXyh3.Value = spbXyh3.Min
End If
End Sub
Sub 設置號碼規模()
'設置幸運號和解除號的規模
spbXyh1.Max = txtMax.Value
spbXyh2.Max = txtMax.Value
spbXyh3.Max = txtMax.Value
spbPch1.Max = txtMax.Value
spbPch2.Max = txtMax.Value
spbPch3.Max = txtMax.Value
End Sub
7
第六，設置號碼生當作按鈕的VBA代碼：
Private Sub cmdStart_Click()
Dim i As Integer, j As Integer
Dim intXyh(3) As Integer, intPch(3) As Integer
Dim intCs As Integer, strMsg As String

intCs = 0
intXyh(1) = txtXyh1.Value '幸運號
intXyh(2) = txtXyh2.Value '幸運號
intXyh(3) = txtXyh3.Value '幸運號
intPch(1) = txtPch1.Value '解除號
intPch(2) = txtPch2.Value '解除號
intPch(3) = txtPch3.Value '解除號
For i = 1 To 3
For j = 1 To 3
If intXyh(i) = intPch(j) Then
If intXyh(i) <> 0 Then
MsgBox "你選擇的幸運號和解除號有反復，請從頭選擇。"
Exit Sub
End If
End If
Next j
Next i

Sheets("號碼").Cells.ClearContents '斷根“號碼”工作表中的原稀有據
For i = 1 To Int(txtScs.Value)
Do While intCs < 1000
intCs = intCs + 1
If intCs > 1000 Then
strMsg = MsgBox("系統已運行一千次，仍未找出合適的號，繼續找嗎？", vbYesNo)
If strMsg = vbNo Then
Exit Do
End If
If strMsg = vbYes Then intCs = 0
End If

隨機生當作號碼
If chkCf.Value = False Then
判定反復
If Sheets("選號").Range("Sfcf") = False Then GoTo repeat1
End If

判定幸運號
If Sheets("選號").Range("Xyh") = False Then GoTo repeat1

判定解除號
If Sheets("選號").Range("Pch") = False Then GoTo repeat1

If chkPx.Value = True Then
排序
End If
連號
If Sheets("選號").Range("Lianhao") = False Then GoTo repeat1

Me.Hide
Sheets("選號").Activate
strMsg = MsgBox("第" & i & "注號碼生當作了，你可以選擇保留號碼到表格," & vbCrLf _
& "或從頭生當作該注號碼。是否保留？", vbYesNo, "保留號碼")
If strMsg = vbYes Then
'保留到表格中
Sheets("選號").Select
Sheets("號碼").Cells(i, 1) = Cells(1, 1)
Sheets("號碼").Cells(i, 2) = Cells(1, 2)
Sheets("號碼").Cells(i, 3) = Cells(1, 3)
Sheets("號碼").Cells(i, 4) = Cells(1, 4)
Sheets("號碼").Cells(i, 5) = Cells(1, 5)
Sheets("號碼").Cells(i, 6) = Cells(1, 6)
Sheets("號碼").Cells(i, 7) = Cells(1, 7)
Exit Do
End If
repeat1:
Loop
Next
Sheets("號碼").Activate
End Sub
8
第七，接著點擊插入——模塊——然后在模塊那邊輸入如下VBA代碼：
Public Sub 隨機生當作號碼()
Dim intMax As Integer, intMzhs As Integer, i As Integer
intMax = frmCp.txtMax.Value '最大號碼
intMzhs = frmCp.txtMzhs.Value '每注號數
For i = 1 To intMzhs
Randomize
Sheets("選號").Cells(1, i) = Int(intMax * Rnd + 1)
Next
End Sub
Public Sub 判定反復()
Dim intMzhs As Integer, i As Integer, j As Integer
intMzhs = frmCp.txtMzhs.Value '每注號數
For i = 1 To intMzhs - 1
For j = i + 1 To intMzhs
If Sheets("選號").Cells(1, i) = Sheets("選號").Cells(1, j) Then
Sheets("選號").Range("Sfcf") = False
Exit Sub
End If
Next j
Next i
Sheets("選號").Range("Sfcf") = True
End Sub
Public Sub 判定幸運號()
Dim intXyh(3) As Integer, intMzhs As Integer
Dim x(3) As Boolean, i As Integer, intTemp As Integer
Dim j As Integer
intMzhs = frmCp.txtMzhs.Value '每注號數
intXyh(1) = frmCp.txtXyh1.Value '幸運號
intXyh(2) = frmCp.txtXyh2.Value '幸運號
intXyh(3) = frmCp.txtXyh3.Value '幸運號
If intXyh(1) = 0 And intXyh(2) = 0 And intXyh(3) = 0 Then
Sheets("選號").Range("Xyh") = True
Exit Sub
End If
For i = 1 To 3
If intXyh(i) = 0 Then x(i) = True
Next
For i = 1 To intMzhs
intTemp = Sheets("選號").Cells(1, i)
For j = 1 To 3
If intXyh(j) - intTemp = 0 Then x(j) = True
Next j
If x(1) = True And x(2) = True And x(3) = True Then
Sheets("選號").Range("Xyh") = True
Exit Sub
End If
Next
Sheets("選號").Range("Xyh") = False
End Sub
Public Sub 判定解除號()
Dim intPch(3) As Integer, intMzhs As Integer
Dim x(3) As Boolean, i As Integer, intTemp As Integer
Dim j As Integer

For i = 1 To 3
x(i) = True
Next
intMzhs = frmCp.txtMzhs.Value '每注號數
intPch(1) = frmCp.txtPch1.Value '解除號
intPch(2) = frmCp.txtPch2.Value '解除號
intPch(3) = frmCp.txtPch3.Value '解除號
If intPch(1) = 0 And intPch(2) = 0 And intPch(3) = 0 Then
Sheets("選號").Range("Pch") = True
Exit Sub
End If
For i = 1 To 3
If intPch(i) = 0 Then x(i) = True
Next
For i = 1 To intMzhs
intTemp = Sheets("選號").Cells(1, i)
For j = 1 To 3
If intPch(j) - intTemp = 0 Then x(j) = False
Next j
Next
If x(1) = True And x(2) = True And x(3) = True Then
Sheets("選號").Range("Pch") = True
Else
Sheets("選號").Range("Pch") = False
End If
End Sub
Public Sub 排序()
Sheets("選號").Range("1:1").Select
Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlLeftToRight, SortMethod _
:=xlPinYin
End Sub
Public Sub 連號()
Dim intMzhs As Integer
Dim i As Integer
intMzhs = frmCp.txtMzhs.Value '每注號數
With Sheets("選號")
If frmCp.opt1.Value = True Then '不考慮連號
.Range("Lianhao") = True
Exit Sub
End If

If frmCp.opt2.Value = True Then '二連號
For i = 1 To intMzhs - 1
If .Cells(1, i + 1) - .Cells(1, i) = 1 Then
.Range("Lianhao") = True
Exit Sub
End If
Next
End If

If frmCp.opt3.Value = True Then '三連號
For i = 1 To intMzhs - 2
If .Cells(1, i + 1) - .Cells(1, i) = 1 And _
.Cells(1, i + 2) - .Cells(1, i + 1) = 1 Then
.Range("Lianhao") = True
Exit Sub
End If
Next
End If

If frmCp.opt4.Value = True Then '四連號
For i = 1 To intMzhs - 3
If .Cells(1, i + 1) - .Cells(1, i) = 1 And _
.Cells(1, i + 2) - .Cells(1, i + 1) = 1 And _
.Cells(1, i + 3) - .Cells(1, i + 2) = 1 Then
.Range("Lianhao") = True
Exit Sub
End If
Next
End If
.Range("Lianhao") = False
End With
End Sub
Sub 生當作號碼()
Range("A1:G1").Select
Selection.ClearContents
frmCp.Show
End Sub
9
最后，右擊選號表格的選號文本框——指心猿意馬宏——選擇生當作碼號，然后點擊就可以主動生當作號碼了。