“自编双色球缩水程序（VB语言）”

Private Sub CommandButton2_Click()
Range("k2:bx65536").ClearContents
Application.Calculate
Range("k3:bx65536").Calculate
nRow = Range("b65536").End(xlUp).Row
Dim nStart, nStar5, nCoun5, nCount, s
s = 0
nStart = nRow - 30
nStar5 = nRow - 5
Dim c(49), e(49)
For k = 1 To 33
c(k) = 0
For i = nStart To (nRow)
For n = 3 To 8
If Cells(i, n) = k Then c(k) = c(k) + 1
Next:Next:Next
For k = 1 To 33
e(k) = 0
For i = nStar5 To (nRow + 0)
For n = 3 To 8
If Cells(i, n) = k Then e(k) = e(k) + 1
Next:Next:Next
'预测红球
Dim d(6), f(6), nKN(7), CS(13), lh(13)
For i = 1 To 17
d(0) = c(i): f(0) = e(i): nKN(1) = i
For j = 2 To 20
d(1) = c(i): f(1) = e(i): nKN(2) = j
For k = 4 To 25
d(2) = c(i): f(2) = e(i): nKN(3) = k
For l = 5 To 30
d(3) = c(i): f(3) = e(i): nKN(4) = l
For m = 11 To 32
d(4) = c(i): f(4) = e(i): nKN(5) = m
For n = 16 To 33
d(5) = c(i): f(5) = e(i): nKN(6) = n
Z = nKN(1) + nKN(2) + nKN(4) + nKN(5) + nKN(6)
R = d(0) + d(1) + d(2) + d(3) + d(4) + d(5)
X = f(0) + f(1) + f(2) + f(3) + f(4) + f(5)
For v = 0 To 12
CS(v) = 0: lh(v) = 0
For p = 0 To 5
If d(p) = v Then CS(v) = CS(v) + 1
If f(p) = v Then lh(v) = lh(v) + 1
Next:Next
If ((R = 25 Or R = 27 Or R = 33) And (X = 5 Or X = 7) And (Z = 88 Or Z = 94 Or Z = 100 Or Z = 66) And nKN(1) < nKN(2) And nKN(2) < nKN(3) And nKN(3) < nKN(4) And nKN(4) < nKN(5) And nKN(5) < nKN(6) And (N1 = 1 Or N1 = 3 Or N1 = 5 Or N1 = 6) And (N6 = 22 Or N6 = 24 Or N6 = 26 Or N6 = 27 Or N6 = 28 Or N6 = 31) And (N2 < 11)) Then
If ((CS(2) + CS(4)) >= 1 And CS(7) = 0 And CS(8) >= 1 And CS(9) <= 1 And CS(2) <= 2 And CS(6) >= 1 And CS(5) <= 2 And CS(6) <= 3 And CS(4) <= 1 And (CS(2) >= 2 Or CS(5) = 2 Or CS(6) >= 2) And lh(0) >= 2 And lh(0) <= 3 And lh(1) >= 1 And lh(1) <= 2 And (lh(2) + CS(3)) >= 1) Then
s=s+1
Cells(nRow + s, 3) = nKN(1): Cells(nRow + s, 4) = nKN(2): Cells(nRow + s, 5) = nKN(3)
Cells(nRow + s, 6) = nKN(4): Cells(nRow + s, 7) = nKN(5): Cells(nRow + s, 8) = nKN(6)
End If
End If
For p = 0 To 5
Cells(nRow + s, 10 + p) = d(p): Cells(nRow + s, 16 + p) = f(p)
For v = 0 To 12
Cells(nRow + s, 22 + v) = CS(v): Cells(nRow + s, 35 + v) = lh(v)
Next: Next: Next: Next: Next: Next:Next: Next
End Sub

抛砖引玉，程序还待完善！（表格内运行慢，没测试出结果，C语言的结果正确）

本帖最后由 duy3 于 2018-2-5 18:59 编辑

原贴数据：
2009057 05 07 10 14 17 25 11
2009058 05 08 10 15 23 26 09
2009059 03 07 13 23 27 30 11
2009060 07 13 17 26 32 33 04
2009061 10 11 13 16 19 30 03
2009062 10 19 20 21 23 32 10
2009063 02 05 11 26 30 32 16
2009064 01 02 14 23 28 29 15
2009065 08 12 20 22 30 33 02
2009066 02 15 19 24 31 32 04
2009067 04 10 16 23 28 30 05
2009068 06 11 18 20 25 30 05
2009069 03 05 12 18 21 23 02
2009070 01 02 09 10 21 31 10
2009071 04 05 23 26 31 32 06
2009072 01 03 12 20 21 29 04
2009073 09 16 17 18 22 27 14
2009074 05 10 16 19 23 28 13
2009075 01 13 15 17 20 30 05
2009076 09 18 19 25 28 31 06
2009077 01 09 14 16 28 32 16
2009078 05 07 12 14 15 20 13
2009079 02 09 16 21 30 31 13
2009080 01 11 13 25 32 33 06
2009081 04 05 06 25 29 30 03
2009082 11 15 18 21 27 29 02
2009083 02 08 12 18 24 28 04
2009084 04 09 11 20 32 33 13
2009085 04 08 12 17 20 30 03
2009086 11 12 13 18 23 32 11

本帖最后由 duy3 于 2018-2-5 18:54 编辑


转：
以上程序运行的结果为：
　　1 8 19 20 22 24 94 27 645822 020201
　　6 8 13 19 20 22 88 27 246582 021020
　　
　　如果你的调试结果与上面一样，说明你知道怎样用该程序了。

本帖最后由 duy3 于 2018-2-5 18:58 编辑

看C语言原贴链接

int a[30][6]={{5,7,10,14,17,25},
　　 {5,8,10,15,23,26},{3,7,13,23,27,30},{7,13,17,26,32,33},
　　 {10,11,13,16,19,30},{10,19,20,21,23,32},{2,5,11,26,30,32},
　　 {1,2,14,23,28,29},{8,12,20,22,30,33},{2,15,19,24,31,32},
　　 {4,10,16,23,28,30},{6,11,18,20,25,30},{3,5,12,18,21,23},
　　 {1,2,9,10,21,31},{4,5,23,26,31,32},{1,3,12,20,21,29},
　　 {9,16,17,18,22,27},{5,10,16,19,23,28},{1,13,15,17,20,30},
　　 {9,18,19,25,28,31},{1,9,14,16,28,32},{5,7,12,14,15,20},
　　 {2,9,16,21,30,31},{1,11,13,25,32,33},{4,5,6,25,29,30},
　　 {11,15,18,21,27,29},{2,8,12,18,24,28},{4,9,11,20,32,33},
　　 {4,8,12,17,20,30},{11,12,13,18,23,32}};



　　 int b[5][6]={{11,15,18,21,27,29},{2,8,12,18,24,28},
　　 {4,9,11,20,32,33},{4,8,12,17,20,30},{11,12,13,18,23,32}};

原贴中数据：
int a[30][6]={{5,7,10,14,17,25},
　　 {5,8,10,15,23,26},{3,7,13,23,27,30},{7,13,17,26,32,33},
　　 {10,11,13,16,19,30},{10,19,20,21,23,32},{2,5,11,26,30,32},
　　 {1,2,14,23,28,29},{8,12,20,22,30,33},{2,15,19,24,31,32},
　　 {4,10,16,23,28,30},{6,11,18,20,25,30},{3,5,12,18,21,23},
　　 {1,2,9,10,21,31},{4,5,23,26,31,32},{1,3,12,20,21,29},
　　 {9,16,17,18,22,27},{5,10,16,19,23,28},{1,13,15,17,20,30},
　　 {9,18,19,25,28,31},{1,9,14,16,28,32},{5,7,12,14,15,20},
　　 {2,9,16,21,30,31},{1,11,13,25,32,33},{4,5,6,25,29,30},
　　 {11,15,18,21,27,29},{2,8,12,18,24,28},{4,9,11,20,32,33},
　　 {4,8,12,17,20,30},{11,12,13,18,23,32}};
　　 int b[5][6]={{11,15,18,21,27,29},{2,8,12,18,24,28},
　　 {4,9,11,20,32,33},{4,8,12,17,20,30},{11,12,13,18,23,32}};

我表格直接卡了 等了半小时 硬没反应过来 然后只能三件组合了

我表格直接卡了 等了半小时 硬没反应过来 然后只能三件组合了

我表格直接卡了 等了半小时 硬没反应过来 然后只能三件组合了

For i = 1 To 17
d(0) = c(i): f(0) = e(i): nKN(1) = i
For j = 2 To 20
d(1) = c(j): f(1) = e(j): nKN(2) = j
For k = 4 To 25
d(2) = c(k): f(2) = e(k): nKN(3) = k
For l = 5 To 30
d(3) = c(l): f(3) = e(l): nKN(4) = l
For m = 11 To 32
d(4) = c(m): f(4) = e(m): nKN(5) = m
For n = 16 To 33
d(5) = c(n): f(5) = e(n): nKN(6) = n

Private Sub CommandButton2_Click()
Range("k2:bx65536").ClearContents
APPlication.Calculate
Range("k3:bx65536").Calculate
nRow = Range("b65536").End(xlUp).Row
Dim nStart, nStar5, nCoun5, nCount, s
s = 0
nStart = nRow - 30
nStar5 = nRow - 5
Dim c(49), e(49)
For k = 1 To 33
c(k) = 0
For i = nStart To (nRow)
For n = 3 To 8
If Cells(i, n) = k Then c(k) = c(k) + 1
Next:Next:Next
For k = 1 To 33
e(k) = 0
For i = nStar5 To (nRow + 0)
For n = 3 To 8
If Cells(i, n) = k Then e(k) = e(k) + 1
Next:Next:Next
'预测红球
Dim d(6), f(6), nKN(7), CS(13), lh(13)
For k = 1 To 33
For n = 3 To 8
If Cells(nRow , n) = k Then d(n-3) = c(k): f(n-3) = e(k): nKN(n-2) = k
Z = nKN(1) + nKN(2) + nKN(4) + nKN(5) + nKN(6)
R = d(0) + d(1) + d(2) + d(3) + d(4) + d(5)
X = f(0) + f(1) + f(2) + f(3) + f(4) + f(5)
For v = 0 To 12
CS(v) = 0: lh(v) = 0
For p = 0 To 5
If d(p) = v Then CS(v) = CS(v) + 1
If f(p) = v Then lh(v) = lh(v) + 1
Next:Next
If ((R = 25 Or R = 27 Or R = 33) And (X = 5 Or X = 7) And (Z = 88 Or Z = 94 Or Z = 100 Or Z = 66) And nKN(1) < nKN(2) And nKN(2) < nKN(3) And nKN(3) < nKN(4) And nKN(4) < nKN(5) And nKN(5) < nKN(6) And (N1 = 1 Or N1 = 3 Or N1 = 5 Or N1 = 6) And (N6 = 22 Or N6 = 24 Or N6 = 26 Or N6 = 27 Or N6 = 28 Or N6 = 31) And (N2 < 11)) Then
If ((CS(2) + CS(4)) >= 1 And CS(7) = 0 And CS(8) >= 1 And CS(9) <= 1 And CS(2) <= 2 And CS(6) >= 1 And CS(5) <= 2 And CS(6) <= 3 And CS(4) <= 1 And (CS(2) >= 2 Or CS(5) = 2 Or CS(6) >= 2) And lh(0) >= 2 And lh(0) <= 3 And lh(1) >= 1 And lh(1) <= 2 And (lh(2) + CS(3)) >= 1) Then
s=s+1
Cells(nRow + s, 3) = nKN(1): Cells(nRow + s, 4) = nKN(2): Cells(nRow + s, 5) = nKN(3)
Cells(nRow + s, 6) = nKN(4): Cells(nRow + s, 7) = nKN(5): Cells(nRow + s, 8) = nKN(6)
End If
End If
Next:Next
For p = 0 To 5
Cells(nRow + s, 10 + p) = d(p): Cells(nRow + s, 16 + p) = f(p)
For v = 0 To 12
Cells(nRow + s, 22 + v) = CS(v): Cells(nRow + s, 35 + v) = lh(v)
Next: Next
End Sub

运行挺快 但是运行结果不太对 我论坛等级低 无法上传图片和文件 实在遗憾

2217 2018011 3 10 21 23 27 33 11
2218 2018012 11 12 13 19 26 28 12
2219 2018013 6 8 13 15 22 33 6
2220 2018014 9 12 20 24 28 31 7
2221 2018015 11 15 20 21 26 33 15
2222 2018016 1 11 12 18 25 27 16
2223 2018017 3 6 11 26 30 32 12 4 7 9 9 3 4 1 2 4 3 1 1 0 0 0 1 2 0 0 1 0 2 0 0 0 0 3 1 1 1 0 0 0 0 0 0 0 0
2224

我想跟你学一下

大老粗看不懂，我只想你把软件做出来给大家用就成。这里不是程序员的位置，都是彩市中的迷妹

求大神编写个小程序，模拟双色球，随机2亿组双色球，可言重复，从中挑出重复最少得几注

赞一个。