求高手指教：如何用VBA在EXCEL中生成双色球红球33选6的所有组合明细

香川群子

老谭酸菜 发表于 2013-9-23 09:04
群子难道没这样用过？
On Error Goto lab1
      .....

我没有这样用过……

或许是孤陋寡闻，但Goto 语句应该少用甚至不用，你是否听说过呢？


另外，既然已经没节操地用了Goto语句，那么你的If语句也是不必要的，可以这样：

Sub TEST()

    On Error GoTo lab1
        过程1   
        GoTo lab2
lab1:
       过程2
lab2:
       过程3
     On Error GoTo 0

End Sub

有错实行 过程2→ 过程3
无错实行 过程1→ 过程3


呵呵，所以 IF 1=2 Then 依然是傻瓜代码。

老谭酸菜

香川群子 发表于 2013-9-23 16:55
我没有这样用过……

或许是孤陋寡闻，但Goto 语句应该少用甚至不用，你是否听说过呢？

说 IF  1=2 Then 是傻瓜代码就等于说 GOTO 是傻瓜代码，小心微软恼了取消你用VB的资格！到时候你就该{:soso_e109:}咯。 {:soso_e128:}

wzb1972wzb

香川群子 发表于 2012-2-13 00:53
组合结果分成6列输出的代码：

您好，运行后，sheet1填满后怎么向后面的表填充。谢谢。显示下标越界

1484510025

牛掰啊  都是大神啊

sunnypower

香川群子 发表于 2012-2-5 23:45
33选6，组合结果共=1,107,568

在2003中可以排满接近17列……

大师，你好！如何在你的这个程序里面设置多重筛选条件，就是如果我只需要其中的某些组合，比如奇偶数比是3:3的,或者4:2的 ....还有和值在100~120之间的等等条件。
希望大师指点迷津。
盼回复，
不甚感激！

fqexcel

组合结果分成6列输出的代码：
Sub Combin_33_6_6()
    Dim a%, b%, c%, d%, e%, f%,k&, l%, m&, s$
    m = 4 ^ 10
    ReDim r(1 To m, 1 To 6)
   
    For a = 1 To 33 - 5
    For b = a + 1 To 33 - 4
    For c = b + 1 To 33 - 3
    For d = c + 1 To 33 - 2
    For e = d + 1 To 33 - 1
    For f = e + 1 To 33
        k = k+ 1
        If k> m Then
           Cells(1, l * 7 + 1).Resize(m, 6) = r
           ReDim r(1 To m, 1 To 1)
           l = l + 1
           k = 1
        EndIf
        r(k,1) = a
        r(k,2) = b
        r(k,3) = c
        r(k,4) = d
        r(k,5) = e
        r(k,6) = f
   
    Next f, e, d, c, b, a
    Cells(1, l * 7 + 1).Resize(k,6) = r
End Sub

写满了第一张表格，写到第 1048576 个组合结果是：12，17，22，27，28，33，就弹出运行错误'9':下标越界，这怎么解决啊？

q563262982

香川群子 发表于 2012-2-13 00:50
组合结果合并成一列，含输出结果的代码：

请问如果是要写成33选5，需要在里面改哪些地方。或者如果您方便发一下，我对比一下，感谢！

1484510025

香川群子 发表于 2012-2-5 23:45
33选6，组合结果共=1,107,568

在2003中可以排满接近17列……

各位大神，下面这个算法表格只能生产110万个数据，比实际1107568少了7568个数据，是什么原因呢，哪位大神帮忙查下问题，给个修改方案，谢谢！！！
-----------------------------------------
r = 1
    col = 2
    i = 1
    n = 10000
   
    tmp = Application.WorksheetFunction.Combin(33, 6)
    Cells(1, 1) = "共" & tmp & "组合"
    Cells(2, 1) = "每列" & n & "行"
    Cells(3, 1) = "共需" & -Int(-tmp / n) & "列"

    ReDim a(1 To n)
   
    For i1 = 1 To 28
    For i2 = i1 + 1 To 29
    For i3 = i2 + 1 To 30
    For i4 = i3 + 1 To 31
    For i5 = i4 + 1 To 32
    For i6 = i5 + 1 To 33
        a(i) = Join(Array(i1, i2, i3, i4, i5, i6), " ")
        If i < n Then
            i = i + 1
        Else
            Cells(r, col).Resize(n) = Application.WorksheetFunction.Transpose(a)
            i = 1
            col = col + 1
'            If MsgBox(n, vbOKCancel) <> vbOK Then GoTo 1000
        End If
    Next
    Next
    Next
    Next
    Next
    Next
1000:
    MsgBox "ok！"
End Sub

fengjinbiao88

有没有办法写个程序生成下一期的开奖号码？