Private Sub Command1_Click()
Dim cpssq() As Long, cpssq1() As Long, cpssqup1(0, 1 To 6) As Long, cpssqup2(0, 1 To 6), cpssqup3(0, 1 To 6), cpssqup4(0, 1 To 6), cpssqup5(0, 1 To 6), cpssqup6(0, 1 To 6), cpssqup7(0, 1 To 6), cpssqup8(0, 1 To 6), cpssqup9(0, 1 To 6), cpssqup10(0, 1 To 6), cpssqsj1(0, 1 To 6), cpssqsj2(0, 1 To 6), cpssqpch(15) As Long, changliang As Long, zf As String
Dim x As Long, y, z, w, a, b, c, d, e, f, a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, b1, b2, b3, b4, b5, b6, b7, b8, b9, b10, b11, maxa, mina, k1, k2, suma As Integer, n As Integer
cpssqup1(0, 1) = Val("text1.text")
cpssqup1(0, 2) = Val("text2.text")
cpssqup1(0, 3) = Val("text3.text")
cpssqup1(0, 4) = Val("text4.text")
cpssqup1(0, 5) = Val("text5.text")
cpssqup1(0, 6) = Val("text6.text")
cpssqup2(0, 1) = Val("text7.text")
cpssqup2(0, 2) = Val("text8.text")
cpssqup2(0, 3) = Val("text9.text")
cpssqup2(0, 4) = Val("text10.text")
cpssqup2(0, 5) = Val("text11.text")
cpssqup2(0, 6) = Val("text12.text")
cpssqup3(0, 1) = Val("text13.text")
cpssqup3(0, 2) = Val("text14.text")
cpssqup3(0, 3) = Val("text15.text")
cpssqup3(0, 4) = Val("text16.text")
cpssqup3(0, 5) = Val("text17.text")
cpssqup3(0, 6) = Val("text18.text")
cpssqup4(0, 1) = Val("text19.text")
cpssqup4(0, 2) = Val("text20.text")
cpssqup4(0, 3) = Val("text21.text")
cpssqup4(0, 4) = Val("text22.text")
cpssqup4(0, 5) = Val("text23.text")
cpssqup4(0, 6) = Val("text24.text")
cpssqup5(0, 1) = Val("text25.text")
cpssqup5(0, 2) = Val("text26.text")
cpssqup5(0, 3) = Val("text27.text")
cpssqup5(0, 4) = Val("text28.text")
cpssqup5(0, 5) = Val("text29.text")
cpssqup5(0, 6) = Val("text30.text")
cpssqup6(0, 1) = Val("text31.text")
cpssqup6(0, 2) = Val("text32.text")
cpssqup6(0, 3) = Val("text33.text")
cpssqup6(0, 4) = Val("text34.text")
cpssqup6(0, 5) = Val("text35.text")
cpssqup6(0, 6) = Val("text36.text")
cpssqup7(0, 1) = Val("text37.text")
cpssqup7(0, 2) = Val("text38.text")
cpssqup7(0, 3) = Val("text39.text")
cpssqup7(0, 4) = Val("text40.text")
cpssqup7(0, 5) = Val("text41.text")
cpssqup7(0, 6) = Val("text42.text")
cpssqup8(0, 1) = Val("text43.text")
cpssqup8(0, 2) = Val("text44.text")
cpssqup8(0, 3) = Val("text45.text")
cpssqup8(0, 4) = Val("text46.text")
cpssqup8(0, 5) = Val("text47.text")
cpssqup8(0, 6) = Val("text48.text")
cpssqup9(0, 1) = Val("text49.text")
cpssqup9(0, 2) = Val("text50.text")
cpssqup9(0, 3) = Val("text51.text")
cpssqup9(0, 4) = Val("text52.text")
cpssqup9(0, 5) = Val("text53.text")
cpssqup9(0, 6) = Val("text54.text")
cpssqup10(0, 1) = Val("text55.text")
cpssqup10(0, 2) = Val("text56.text")
cpssqup10(0, 3) = Val("text57.text")
cpssqup10(0, 4) = Val("text58.text")
cpssqup10(0, 5) = Val("text59.text")
cpssqup10(0, 6) = Val("text60.text")
cpssqsj1(0, 1) = Val("text61.text")
cpssqsj1(0, 2) = Val("text62.text")
cpssqsj1(0, 3) = Val("text63.text")
cpssqsj1(0, 4) = Val("text64.text")
cpssqsj1(0, 5) = Val("text65.text")
cpssqsj1(0, 6) = Val("text66.text")
cpssqsj2(0, 1) = Val("text67.text")
cpssqsj2(0, 2) = Val("text68.text")
cpssqsj2(0, 3) = Val("text69.text")
cpssqsj2(0, 4) = Val("text70.text")
cpssqsj2(0, 5) = Val("text71.text")
cpssqsj2(0, 6) = Val("text72.text")
x = 1000000
changliang = x
ReDim cpssq(1 To x, 1 To 6)
x = 1
For a = 1 To 8 '赋值
For b = a + 1 To 15
For c = b + 1 To 30
For d = c + 1 To 31
For e = 17 To 32
If e > d Then
For f = 23 To 33
If f > e Then
cpssq(x, 1) = a
cpssq(x, 2) = b
cpssq(x, 3) = c
cpssq(x, 4) = d
cpssq(x, 5) = e
cpssq(x, 6) = f
End If
Next f
End If
Next e
Next d
Next c
Next b
Next a
cpssq1 = cpssq
d = x
ReDim cpssq(1 To x, 1 To 6)
x = 1
For w = 1 To d
If cpssq1(w, 1) <> 0 Then
For y = 1 To 6
cpssq(x, y) = cpssq1(w, y)
Next y
x = x + 1
End If
Next w
For x = 1 To d
If cpssq(x, 1) <> 0 Then
For y = 1 To 4 '去3连
If cpssq(x, y + 2) - cpssq(x, y) = 2 Then cpssq(x, 1) = 0
Next y
a1 = cpssq(x, 6) - cpssq(x, 5)
If a1 = cpssq(x, 4) - cpssq(x, 3) And a1 = cpssq(x, 2) - cpssq(x, 1) Then cpssq(x, 1) = 0
suma = cpssq(x, 1) + cpssq(x, 2) + cpssq(x, 3) + cpssq(x, 4) + cpssq(x, 5) + cpssq(x, 6)
If suma > 135 Or suma < 70 Then cpssq(x, 1) = 0 '排和值
a = cpssqup1(0, 1) + cpssqup1(0, 2) + cpssqup1(0, 3) + cpssqup1(0, 4) + cpssqup1(0, 5) + cpssqup1(0, 6)
If a = suma Then cpssq(x, 1) = 0
If cpssq(x, 1) + cpssq(x, 6) < 24 Or cpssq(x, 1) + cpssq(x, 6) > 45 Then cpssq(x, 1) = 0
If cpssq(x, 1) + cpssq(x, 6) = cpssqup1(0, 6) + cpssqup1(o, 6) Then cpssq(x, 1) = 0
End If
Next x
maxa = 0
z = 0
w = d
For x = 1 To w '排最大间距7－15
If cpssq(x, 1) <> 0 Then
For y = 1 To 5
z = cpssq(x, y + 1) - cpssq(x, y)
If z > maxa Then maxa = z
Next y
If maxa > 15 Or maxa < 7 Then cpssq(x, 1) = 0
maxa = 0
End If
Next x
d = 0
e = 0
f = 0
For z = 1 To 6
Select Case cpssqup1(0, z)
Case Is <= 11
d = d + 1
Case Is <= 22
e = e + 1
Case Is <= 33
f = f + 1
End Select
Next z
For x = 1 To w '3区分法没区最多出3个
If cpssq(x, 1) <> 0 Then
a = 0
b = 0
c = 0
For y = 1 To 6
Select Case cpssq(x, y)
Case Is <= 11
a = a + 1
Case Is <= 22
b = b + 1
Case Is <= 33
c = c + 1
End Select
Next y
If b = 0 Or a = 0 Then cpssq(x, 1) = 0
If a > 3 Or b > 3 Or c > 3 Then cpssq(x, 1) = 0
If a = 2 And b = 2 Then cpssq(x, 1) = 0
If a = d And b = e And c = f Then cpssq(x, 1) = 0
End If
Next x
For x = 1 To w '0156排除
If cpssq(x, 1) <> 0 Then
a = 0
For y = 1 To 6
If cpssq(x, y) Mod 5 = 0 Then a = a + 1
If cpssq(x, y) Mod 5 = 1 Then a = a + 1
Next y
If a = 0 Or a > 4 Then cpssq(x, 1) = 0
End If
Next x
For x = 1 To w '质数1－3个
If cpssq(x, 1) <> 0 Then
a = 0
For y = 1 To 6
Select Case cpssq(x, y)
Case 2, 3, 5, 7, 11, 13, 17, 19, 23, 29, 31
a = a + 1
End Select
Next y
If a = 0 Or a > 3 Then cpssq(x, 1) = 0
End If
Next x
a1 = 0
a2 = 0
a3 = 0
a4 = 0
For z = 1 To 6
Select Case cpssqup1(0, z)
Case Is < 10
a1 = a1 + 1
Case Is < 20
a2 = a2 + 1
Case Is < 30
a3 = a3 + 1
Case Is < 33
a4 = a4 + 1
End Select
Next z
For x = 1 To w '0123统计
If cpssq(x, 1) <> 0 Then
a = 0
b = 0
c = 0
d = 0
e = 0
For y = 1 To 6
Select Case cpssq(x, y)
Case Is < 10
a = a + 1
Case Is < 20
b = b + 1
Case Is < 30
c = c + 1
Case Is <= 33
d = d + 1
End Select
Next y
If a > 3 Or b > 3 Or c > 3 Or d > 2 Then cpssq(x, 1) = 0
If a = 0 Then e = e + 1
If b = 0 Then e = e + 1
If c = 0 Then e = e + 1
If d = 0 Then e = e + 1
If e > 1 Then cpssq(x, 1) = 0
If a = a1 And b = a2 And c = a3 And d = a4 Then cpssq(x, 1) = 0
End If
Next x
a1 = 0
a2 = 0
a3 = 0
a4 = 0
For z = 1 To 6
Select Case cpssqup1(0, z)
Case Is <= 8
a1 = a1 + 1
Case Is <= 16
a2 = a2 + 1
Case Is <= 25
If cpssqup1(0, z) <> 17 Then a3 = a3 + 1
Case Is <= 33
a4 = a4 + 1
End Select
Next z