[已解决]求教高手，请问如何提高这个双循环的效率。

hui112233

Sub 强化()
Dim x, y As Byte
Dim i As Long

k = 0



For g = 1 To 200
'强化等级
x = 0
For i = 1 To 100000

H = Application.WorksheetFunction.RandBetween(1, 100)

'强化几率

If x < 3 Then
y = 100
ElseIf x = 3 Then
y = 60
ElseIf x = 4 Then
y = 40
ElseIf x = 5 Then
y = 20
ElseIf x = 6 Then
y = 10
ElseIf x = 7 Then
y = 8
ElseIf x = 8 Then
y = 7
ElseIf x = 9 Then
y = 6
End If

'强化等级保留规则

If y >= H Then
x = x + 1
ElseIf y < H And x = 9 Then
x = 0
ElseIf y < H And x = 8 Then
x = 0
ElseIf y < H And x < 8 Then
x = x
End If

'强化到10之后退出循环
If x = 10 Then
Exit For
End If



Next i

'强化总次数
k = i + k

MsgBox k

Next g

'平均所需要的次数

[d16] = k / 3









End Sub

最佳答案

月排行榜 / 总排行榜

香川群子

2014-5-28 16:36

如果目的是提速，那么代码还要处理：

1. Sub test()
   
2.     Dim H&, i&, k&, s, x&, y&(9), tms#
   
3.     tms = Timer
   
4.     s = Array(100, 100, 100, 60, 40, 20, 10, 8, 7, 6)
   
5.     For i = 0 To 9
   
6.         y(i) = s(i)
   
7.     Next
   
8.    
   
9.     For i = 1 To 200
   
10.         x = 0
    
11.         Do
    
12.             k = k + 1
    
13.             H = Int(Rnd * 100) + 1
    
14.             If H > y(x) Then
    
15.                 If x > 7 Then x = 0
    
16.             Else
    
17.                 x = x + 1: If x = 10 Then Exit Do
    
18.             End If
    
19.         Loop
    
20.     Next
    
21.    
    
22.     [d16] = k / 3
    
23.     MsgBox Format(Timer - tms, " 0.000s ") & Format(k / 3, "#,##0.0")
    
24. End Sub

复制代码

这样速度可以提升 4-5倍。

跳转到最佳答案楼层

grf1973

简化了一下代码，与循环效率无关。

1. Sub 强化()
   
2.     Dim x, y As Byte
   
3.     Dim i As Long
   
4.     arr = Array(100, 100, 100, 60, 40, 20, 10, 8, 7, 6)
   
5.     For g = 1 To 200
   
6.         x = 0  '强化等级
   
7.         For i = 1 To 100000
   
8.             H = Application.WorksheetFunction.RandBetween(1, 100)
   
9.             y = arr(x)  '强化几率
   
10.             If y >= H Then  '强化等级保留规则
    
11.                 x = x + 1
    
12.             ElseIf x = 9 Or x = 8 Then
    
13.                 x = 0
    
14.             End If
    
15.             If x = 10 Then Exit For  '强化到10之后退出循环
    
16.         Next i
    
17.         k = i + k   '强化总次数
    
18.     Next g
    
19.     [d16] = k / 3  '平均所需要的次数
    
20. End Sub

复制代码

香川群子

grf1973 发表于 2014-5-28 15:15
简化了一下代码，与循环效率无关。

中间用Do循环更合理吧。

1. Sub test()
   
2.     Dim H&, i&, k&, x&, y, tms#
   
3.     tms = Timer
   
4.    
   
5.     y = Array(100, 100, 100, 60, 40, 20, 10, 8, 7, 6)
   
6.     For i = 1 To 200
   
7.         x = 0
   
8.         Do
   
9.             k = k + 1
   
10.             H = Int(Rnd * 100) + 1
    
11.             If H > y(x) Then
    
12.                 If x > 7 Then x = 0
    
13.             Else
    
14.                 x = x + 1: If x = 10 Then Exit Do
    
15.             End If
    
16.         Loop
    
17.     Next
    
18.    
    
19.     [d16] = k / 3
    
20.     MsgBox Format(Timer - tms, " 0.000s ") & Format(k / 3, "#,##0.0")
    
21. End Sub

复制代码

香川群子

如果目的是提速，那么代码还要处理：

1. Sub test()
   
2.     Dim H&, i&, k&, s, x&, y&(9), tms#
   
3.     tms = Timer
   
4.     s = Array(100, 100, 100, 60, 40, 20, 10, 8, 7, 6)
   
5.     For i = 0 To 9
   
6.         y(i) = s(i)
   
7.     Next
   
8.    
   
9.     For i = 1 To 200
   
10.         x = 0
    
11.         Do
    
12.             k = k + 1
    
13.             H = Int(Rnd * 100) + 1
    
14.             If H > y(x) Then
    
15.                 If x > 7 Then x = 0
    
16.             Else
    
17.                 x = x + 1: If x = 10 Then Exit Do
    
18.             End If
    
19.         Loop
    
20.     Next
    
21.    
    
22.     [d16] = k / 3
    
23.     MsgBox Format(Timer - tms, " 0.000s ") & Format(k / 3, "#,##0.0")
    
24. End Sub

复制代码

这样速度可以提升 4-5倍。

hui112233

香川群子 发表于 2014-5-28 16:36
如果目的是提速，那么代码还要处理：这样速度可以提升 4-5倍。

谢谢。确实快了很多很多。
可是最后的平均值好像不对呀。

hui112233

香川群子 发表于 2014-5-28 16:36
如果目的是提速，那么代码还要处理：这样速度可以提升 4-5倍。

改了一下，可以了。谢谢。
以后还请多多指教哈。
Sub test()
    Dim H&, i&, k&, s, x&, y&(9), tms#
    tms = Timer
    s = Array(100, 100, 100, 60, 40, 20, 10, 8, 7, 6)
    For i = 0 To 9
        y(i) = s(i)
    Next

    For i = 1 To 200
        x = 0
        k = 0
        Do
            k = k + 1
            H = Int(Rnd * 100) + 1
            If H > y(x) Then
                If x > 7 Then x = 0
            Else
                x = x + 1: If x = 10 Then Exit Do
            End If
        Loop
        j = j + k
    Next

    [d16] = j / i
    MsgBox Format(Timer - tms, " 0.000s ") & Format(k / 3, "#,##0.0")
End Sub

香川群子

hui112233 发表于 2014-5-28 17:53
改了一下，可以了。谢谢。
以后还请多多指教哈。
Sub test()

…………顺便说，可以一个Do循环完成：

1. Sub test()
   
2.     Dim H&, i&, k&, s, x&, y&(9), cnt&, tms#
   
3.     tms = Timer
   
4.    
   
5.     s = Array(100, 100, 100, 60, 40, 20, 10, 8, 7, 6) '在这里设置10档基础数据
   
6.     For i = 0 To 9
   
7.         y(i) = s(i) ' 把基础数据转换为Long类型数组y 这样可以大大提高速度
   
8.     Next
   
9.    
   
10. '    x = 0: k = 0 '计数变量的初始化并非必要
    
11.     Do
    
12.         k = k + 1 '测试次数k统计+1
    
13.         H = Int(Rnd * 100) + 1 '获取随机数
    
14.         If H > y(x) Then
    
15.             If x > 7 Then x = 0
    
16.         Else
    
17.             x = x + 1
    
18.             If x = 10 Then x = 0: cnt = cnt + 1 '当x=10时完成一个轮次的测试
    
19.         End If
    
20.     Loop Until cnt = 200 '在这里设置需要测试的轮次数cnt
    
21.    
    
22.     [d16] = k / cnt '平均值计算=【测试次数k】/【总测试轮次数cnt】
    
23.     MsgBox cnt & Format(Timer - tms, " 0.000s ") & Format(k / cnt, "#,##0.0")
    
24. End Sub

复制代码

香川群子

结论：
楼主要求的双循环，变成了一个Do……Loop的单循环。

香川群子

hui112233 发表于 2014-5-28 17:53
改了一下，可以了。谢谢。
以后还请多多指教哈。
Sub test()

你这里的平均数计算有错误：
[d16] = j / i

循环终止时 i =201 而不是 200，因此正确的计算是：[d16] = j / (i-1)

以后一定要记住这个循环计数变量的特点。

pukhpe

请问楼主，你这个具体用于什么，用发出来看看吗？