【求解】模拟彩票计算组合:EXCEL 宏实现
excel 中,A1~A9 填充9个数字。 通过运行宏,取6个数的组合。 填充在excel中。应该有84个组合。
请提供宏:
[最优解释]
Dim j As Long
Dim buff() As String
Dim l As Integer '排列长度
Dim ss As Variant '位置
Private Sub Make_CString(ByVal n As Long, ByVal ls As String)
Dim t As String
For i = n To 0 Step -1
t = ls & ss(i)
If Len(t) = l Then
Range("A" & j + 1) = t '存放找到的组合
buff(j) = t '存放找到的组合
j = j + 1
Else
Make_CString i - 1, t
End If
Next i
End Sub
Public Sub C排列()
Dim s As Variant, i As Long, t As Long
j = 1: l = 6
ss = Split("1,2,3,4,5,6,7,8,9", ",")
ReDim buff(1 To 84)
' Cells.ClearContents
Make_CString UBound(ss), ""
End Sub
302725
302719
302717
302712
302705
302703
302519
302517
302512
302505
302503
301917
301912
301905
301903
301712
301705
301703
301205
301203
300503
272519
272517
272512
272505
272503
271917
271912
271905
271903
271712
271705
271703
271205
271203
270503
251917
251912
251905
251903
251712
251705
251703
251205
251203
250503
191712
191705
191703
191205
191203
190503
171205
171203
170503
120503
[其他解释]
buff()中放的是位置,不是字符。
看以下代码:
Dim j As Long
Dim buff() As String
Dim l As Integer '排列长度
Dim ss As Variant '位置
Private Sub Make_CString(ByVal n As Long, ByVal ls As String)
Dim t As String
For i = n To 0 Step -1
t = ls & ss(i)
If Len(t) = l Then
' Range("A" & j + 1) = t '存放找到的组合
buff(j) = t '存放找到的组合
j = j + 1
Else
Make_CString i - 1, t
End If
Next i
End Sub
Public Sub C排列()
Dim s As Variant, i As Long, t As Long
j = 1: l = 6
ss = Split("1,2,3,4,5,6,7,8,9", ",")
ReDim buff(1 To 84)
Cells.ClearContents
Make_CString UBound(ss), ""
ss = Split("03,05,12,17,19,25,27,30,31", ",")
For i = 1 To 84
For j = 1 To l
Range("A" & i + 1) = Range("A" & i + 1) & ss(CInt(Mid(buff(i), j, 1)) - 1) & ","
Next j
Next i
End Sub
31,30,25,19,05,03,
31,30,25,17,12,05,
31,30,25,17,12,03,
31,30,25,17,05,03,
31,30,25,12,05,03,
31,30,19,17,12,05,
31,30,19,17,12,03,
31,30,19,17,05,03,
31,30,19,12,05,03,
31,30,17,12,05,03,
31,27,25,19,17,12,
31,27,25,19,17,05,
31,27,25,19,17,03,
31,27,25,19,12,05,
31,27,25,19,12,03,
31,27,25,19,05,03,
31,27,25,17,12,05,
31,27,25,17,12,03,
31,27,25,17,05,03,
31,27,25,12,05,03,
31,27,19,17,12,05,
31,27,19,17,12,03,
31,27,19,17,05,03,
31,27,19,12,05,03,
31,27,17,12,05,03,
31,25,19,17,12,05,
31,25,19,17,12,03,
31,25,19,17,05,03,
31,25,19,12,05,03,
31,25,17,12,05,03,
31,19,17,12,05,03,
30,27,25,19,17,12,
30,27,25,19,17,05,
30,27,25,19,17,03,
30,27,25,19,12,05,
30,27,25,19,12,03,
30,27,25,19,05,03,
30,27,25,17,12,05,
30,27,25,17,12,03,
30,27,25,17,05,03,
30,27,25,12,05,03,
30,27,19,17,12,05,
30,27,19,17,12,03,
30,27,19,17,05,03,
30,27,19,12,05,03,
30,27,17,12,05,03,
30,25,19,17,12,05,
30,25,19,17,12,03,
30,25,19,17,05,03,
30,25,19,12,05,03,
30,25,17,12,05,03,
30,19,17,12,05,03,
27,25,19,17,12,05,
27,25,19,17,12,03,
27,25,19,17,05,03,
27,25,19,12,05,03,
27,25,17,12,05,03,
27,19,17,12,05,03,
25,19,17,12,05,03,
[其他解释]
完整代码,结果同上。
Dim BuffCount As Long '计数器
Dim Buff() As String '缓冲区
Dim l As Integer '排列长度
Dim ss As Variant '源字符串
Public Sub C排列()
Dim s As Variant, i As Long, t As Long
BuffCount = 1: l = 6 '选取长度
ss = Split("03,05,12,17,19,25,27,30,31", ",")
'计算 C 排列 m 选 n 的个数, 分配缓冲区
Dim n1 As Long, n2 As Long
t = UBound(ss) + 1
n1 = 1: n2 = 1
For i = 1 To l
n1 = n1 * i
n2 = n2 * (t - i + 1)
Next i
ReDim Buff(1 To n2 \ n1) '分配缓冲区
Cells.ClearContents
Make_CString UBound(ss), "" '开始C排列组合
End Sub
Private Sub Make_CString(ByVal n As Long, ByVal ls As String)
Dim t As String
For i = n To 0 Step -1
t = ls & ss(i) & ","
If UBound(Split(t, ",")) = l Then
Range("A" & BuffCount) = t '存放找到的组合
Buff(BuffCount) = t '存放找到的组合
BuffCount = BuffCount + 1
Else
Make_CString i - 1, t
End If
Next i
End Sub