随即出题代码

上清宫主

Remove耗时哟，且得用前在绑定，不划算

爱疯

Sub test()
    Dim A(), B(), d, i, s1, s2, s3, s
    A = Array(0, 1, 2, 3, 4, 5, 6, 7, 8, 9)
    B = Array("+", "-", "*", "/")
    Set d = CreateObject("scripting.dictionary")
    Do
9
        s1 = Int(UBound(A) * Rnd): s1 = A(s1)
        s2 = Int(UBound(B) * Rnd): s2 = B(s2)
        s3 = Int(UBound(A) * Rnd): s3 = A(s3)
        s = s1 & s2 & s3 & "="
        If InStr(s, "-") And s1 < s3 Then GoTo 9
        i = i + 1: d(s) = i
    Loop Until d.Count = 200
    [a1].Resize(d.Count) = Application.Transpose(d.keys)
End Sub


优点
1）简单

缺点
2）回避了题目关于重复的条件，也就失去本题的学习意义。
2）用了goto
3）可能在特殊条件下慢死。

搁浅2008

爱疯 发表于 2013-9-4 10:56
Sub test()
    Dim A(), B(), d, i, s1, s2, s3, s
    A = Array(0, 1, 2, 3, 4, 5, 6, 7, 8, 9)

你这个是完全不重复 只有+- 凑不够200道

爱疯

搁浅2008 发表于 2013-9-4 11:41
你这个是完全不重复 只有+- 凑不够200道

没发现只要加减。。。。跳到坑里了

sliang28

经过老师提醒，换了一种计算方法可以达到要求，请测试代码。
Private Sub CommandButton1_Click()
    Dim arr(1 To 200, 1 To 1) As Variant
    Dim a As Integer
    Dim i, b, c As Integer
    t = Timer
        Set d = CreateObject("scripting.dictionary")
        For i = 1 To 200
            Do
                a = Int(Rnd() * 100)
                b = Val(Left(a, 1))
                c = Val(Right(a, 1))
                If b < c Then
                    arr(i, 1) = b & "+" & c & "="
                ElseIf Rnd() > 0.5 Then
                    arr(i, 1) = b & "+" & c & "="
                Else
                    arr(i, 1) = b & "-" & c & "="
                End If
            Loop Until d.Exists(arr(i, 1)) = False
            d(arr(i, 1)) = 1
            If i > 20 Then
                d.Remove (arr(i - 20, 1))
            End If
        Next
    Range("A1").Resize(200, 1) = arr
    MsgBox Format(Timer - t, "0.0000秒")
End Sub

上清宫主

扩大到50000个，看速度成不：
Sub test()
t = Timer
Dim d As New Dictionary, ar(1 To 50000, 1 To 1)
Do While r < 50000
  l% = 100 *（1+ Rnd()）
  i1% = mid(l,3, 1)
  i2% = mid(l, 2,1)
  If i1 Mod 2 Then
    s$ = IIf(i1 > i2, i1 & "-" & i2 & "=", i2 & "-" & i1 & "=")
  Else
    s = i1 & "+" & i2 & "="
  End If
  If d.Exists(s) Then
       If r - d(s) >= 20 Then
        r = r + 1
        ar(r, 1) = s
        d(s) = r
       End If
  Else
        r = r + 1
        d(s) = r
        ar(r, 1) = s
  End If
Loop
[a1:a50000] = ar
[b1] = Timer - t
End Sub

sliang28

上清宫主 发表于 2013-9-5 13:40
扩大到50000个，看速度成不：
Sub test()
t = Timer

我测试了一下，5000个我比你的快了6.7倍。{:3912:}

上清宫主

sliang28 发表于 2013-9-5 14:26
我测试了一下，5000个我比你的快了6.7倍。

要发个出来哈{:341:}

sliang28

上清宫主 发表于 2013-9-5 14:32
要发个出来哈

晕，2楼代码就是我的啊！你测试一下，我上午回的。

上清宫主

sliang28 发表于 2013-9-5 14:35
晕，2楼代码就是我的啊！你测试一下，我上午回的。

你确认2楼比16楼快吗？{:4512:}