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

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

你说的“不重合”是指随机产生的一注号码内没重复号的吧？
要保存到 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 了。

引用 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

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