vba来实现6+1不重合排列组合

[zero8500]

想用vba来实现双色球的7位数选择。并且不重合，怎么样实现呢？并生成保存到excel里面，谢谢！

[舉杯邀明月]

你说的“不重合”是指随机产生的一注号码内没重复号的吧？ 要保存到 Excel里，这个说得太含糊了…… 　　是指定文档？还是产生一组号码后新建文档？ 　　每次产生多少注号码？是固定的，还是某范围内随机的？还是产生前自己输入数量？ 唉，还是先看看产生一注号码的吧：

Private Sub Command1_Click()
   Dim sOut As String
   Dim aBuf() As Long, SUM As Long
   Dim i As Long, t As Long
   
   SUM = 32: ReDim aBuf(SUM)
   For i = 0 To SUM
      aBuf(i) = i + 1
   Next
   Randomize: sOut = ""
   For i = 1 To 6          ' 红色球
      t = SUM * Rnd
      sOut = sOut & Right$("0" & aBuf(t), 2) & " "
      aBuf(t) = aBuf(SUM)
      SUM = SUM - 1
   Next
   sOut = sOut & Right$("0" & CInt(1 + 15 * 0.98), 2)
   MsgBox sOut
End Sub

[舉杯邀明月]

晕，　CInt(1 + 15 * 0.98) 这个0.98忘记改成 Rnd 了。

[一如既往哈]

请参考：（彩票有风险，投资须谨慎）

Option Explicit
Sub test()
    Dim iDic As New Dictionary, w1 As String, ww
    Randomize ''随机初始化
    ''红色球1-33任意取6个
    Do
        w1 = Format$(CInt(Rnd * 33) + 1, "0#")
        If Not iDic.Exists(w1) Then iDic(w1) = "0"
        If iDic.Count = 6 Then Exit Do
    Loop
    ''蓝色球取1个
    w1 = Format$(Int(Rnd * 16) + 1, "0#")
    ''输出
    Debug.Print Join(iDic.Keys, ",") & "--" & w1
    iDic.RemoveAll ''清空字典
End Sub

[zero8500]

引用 2 楼 Chen8013 的回复:

你说的“不重合”是指随机产生的一注号码内没重复号的吧？ 要保存到 Excel里，这个说得太含糊了…… 　　是指定文档？还是产生一组号码后新建文档？ 　　每次产生多少注号码？是固定的，还是某范围内随机的？还是产生前自己输入数量？ 唉，还是先看看产生一注号码的吧：

Private Sub Command1_Click()
   Dim sOut As String
   Dim aBuf() As Long, SUM As Long
   Dim i As Long, t As Long
   
   SUM = 32: ReDim aBuf(SUM)
   For i = 0 To SUM
      aBuf(i) = i + 1
   Next
   Randomize: sOut = ""
   For i = 1 To 6          ' 红色球
      t = SUM * Rnd
      sOut = sOut & Right$("0" & aBuf(t), 2) & " "
      aBuf(t) = aBuf(SUM)
      SUM = SUM - 1
   Next
   sOut = sOut & Right$("0" & CInt(1 + 15 * 0.98), 2)
   MsgBox sOut
End Sub

是想有个程序可以把所有的排列组合都可以生成到一个表里面，或者文本里面的。