[已解决]请教老师，有没有更快的速度运行下列程序的代码

爱疯 · 发表于 2014-11-21 19:12

香川群子发表于 2014-11-21 16:44
不考虑输出到工作表的时间，5万行计算比较运算只要0.05秒。

谢谢群子老师！

学习了！！{:021:}

yslvictor · 发表于 2014-11-22 00:58

谢谢各位论坛老师，这些代码都非常的好，用这些代码时，同时把F列的格式变成文本格式，输出时间提高不少。谢谢。

香川群子 · 发表于 2014-11-22 14:45

grf1973 发表于 2014-11-21 16:00
如果数据量再大一点，个人觉得第3种方法可能最快

很规律的数字，应该直接用数组计算和记录，不要用字典……速度会相差数倍！

下面代码算法目前速度最快！

Sub test1()
Dim a$(9), b$(999), i&, i1&, i2&, i3&, s$
For i = 0 To 9 Step 2
a(i) = "偶"
a(i + 1) = "奇"
Next
s = "偶偶偶"
For i1 = 0 To 9
Mid(s, 1, 1) = a(i1)
For i2 = 0 To 9
Mid(s, 2, 1) = a(i2)
For i3 = 0 To 9
Mid(s, 3, 1) = a(i3)
b(i1 * 100 + i2 * 10 + i3) = s
Next i3, i2, i1
[a1].Resize(1000) = WorksheetFunction.Transpose(b)
End Sub

复制代码

优点：
① 全程使用数组而无需使用字典
用a$(9) 记录0-9这10个数字对应的奇偶类型
用b$(999) 记录000-9999这1000个数值对应的奇偶类型

② 直接步长=2循环生成a数组结果，不需要使用Mod 2计算奇偶性。

③ 用0 To 9的3层循环直接生成000-999数值的百位十位个位，速度更快！
用 b(i1 * 100 + i2 * 10 + i3) 来还原3位数值

④ 用Mid函数置换更新s字符串结果，比文本字符串反复拼接的速度要快很多！

呵呵。

香川群子 · 发表于 2014-11-22 14:55

而下面直接拼接的算法，速度要慢一些，大约慢1/3 即 66.7%

Sub test2()
Dim a$(9), b$(999), i&, i1&, i2&, i3&
For i = 0 To 9 Step 2
a(i) = "偶"
a(i + 1) = "奇"
Next
For i1 = 0 To 9
For i2 = 0 To 9
For i3 = 0 To 9
b(i1 * 100 + i2 * 10 + i3) = a(i1) & a(i2) & a(i3)
Next i3, i2, i1
' [a1].Resize(1000) = WorksheetFunction.Transpose(b)
End Sub

复制代码

香川群子 · 发表于 2014-11-22 14:56

而如果不采用3层循环，而是直接000-999循环+字符串拼接，速度也一样的要慢大约1/3 即66.7%

Sub test3()
Dim a$(9), b$(999), i&
For i = 0 To 9 Step 2
a(i) = "偶"
a(i + 1) = "奇"
Next
For i = 0 To 999
b(i) = a(i \ 100) & a(i \ 10 Mod 10) & a(i Mod 10)
Next
[a1].Resize(1000) = WorksheetFunction.Transpose(b)
End Sub

复制代码

香川群子 · 发表于 2014-11-22 15:03

我原来的算法速度也很快……而且是通用算法，即只要改变位数n就可以得到相应的奇偶性判断结果。

Sub test() 'by kagawa 2014/11/21
Dim i&, j&, k&, n&, s$, s1$, s2$, tms#
tms = Timer
n = 3 '可以任意定义位数n
ReDim a&(1 To n)
s1 = "奇" 'ChrW(22855)
s2 = "偶" 'ChrW(20598)
s = String(n, s2)
k = 10 ^ n - 1: ReDim b$(k): b(0) = s
For i = 1 To k
For j = n To 1 Step -1
If a(j) = 9 Then
a(j) = 0
Mid(s, j, 1) = s2
Else
a(j) = a(j) + 1
If a(j) Mod 2 Then Mid(s, j, 1) = s1 Else Mid(s, j, 1) = s2
Exit For
End If
Next
b(i) = s
Next
[b1].Resize(10 ^ n) = WorksheetFunction.Transpose(b)
End Sub

复制代码

代码比较复杂一点，所以耗时也略有增加……大约慢 20%
但是，能够任意设置n位数，这个是我这个代码的特点。

香川群子 · 发表于 2014-11-22 15:11

grf1973 发表于 2014-11-21 16:00
如果数据量再大一点，个人觉得第3种方法可能最快

你的第3种方法用了字典……速度反而更慢，比我的最快代码要慢20倍！

Sub test3()
Dim d, d1, i&, t1&, t2&, t3&
Set d = CreateObject("scripting.dictionary")
Set d1 = CreateObject("scripting.dictionary")
For i = 0 To 9: d(i) = IIf(i Mod 2, "奇", "偶"): Next
For i = 0 To 999
t1 = i \ 100: t2 = (i - t1 * 100) \ 10: t3 = Val(Right(i, 1))
d1(i) = d(t1) & d(t2) & d(t3)
Next
[a1].Resize(1000) = WorksheetFunction.Transpose(d1.items)
End Sub

复制代码

爱疯 · 发表于 2014-11-22 15:12

香川群子发表于 2014-11-22 14:45
很规律的数字，应该直接用数组计算和记录，不要用字典……速度会相差数倍！

下面代码算法目前速度最快 ...

Sub test2()
Dim a$(9), b$(999), i&, i1&, i2&, i3&, s$, j
For i = 0 To 9 Step 2
      a(i) = "偶"
      a(i + 1) = "奇"
Next
s = "偶偶偶"
For i1 = 0 To 9
      Mid(s, 1, 1) = a(i1)

      For i2 = 0 To 9
         Mid(s, 2, 1) = a(i2)

         For i3 = 0 To 9
            Mid(s, 3, 1) = a(i3)
            b(j) = s
            j = j + 1
         Next i3
      Next i2
Next i1
[a1].Resize(1000) = WorksheetFunction.Transpose(b)
End Sub

谢谢群子老师，学习了！
为什么不用j替换下呀？不过好像差异太小，只不过好看清些。

香川群子 · 发表于 2014-11-22 15:19

本帖最后由香川群子于 2014-11-22 15:26 编辑

爱疯发表于 2014-11-22 15:12
Sub test2()
Dim a$(9), b$(999), i&, i1&, i2&, i3&, s$, j
For i = 0 To 9 Step 2

再介绍一种有趣的算法思路：

Sub test4() 'by kagawa 2014/11/22
Dim arr, i&, i1&, i2&, i3&, j&, k&, n&, r&, s$, s1$, s2$, tms#
tms = Timer
n = 3: ReDim a&(1 To n)
s1 = ChrW(22855) '"奇"
s2 = ChrW(20598) '"偶"
s = String(n, s2)
ReDim b$(2 ^ n - 1)
For i1 = 1 To 0 Step -1
Mid(s, 1, 1) = IIf(i1 Mod 2, s1, s2)
For i2 = 1 To 0 Step -1
Mid(s, 2, 1) = IIf(i2 Mod 2, s1, s2)
For i3 = 1 To 0 Step -1
Mid(s, 3, 1) = IIf(i3 Mod 2, s1, s2)
i = i1 * 4 + i2 * 2 + i3
b(i) = s
Next i3, i2, i1
' Exit Sub
k = 10 ^ n - 1: ReDim c$(k): c(0) = b(0)
For i = 1 To k
For j = n To 1 Step -1
If a(j) = 9 Then
a(j) = 0
r = r - 2 ^ (n - j)
Else
a(j) = a(j) + 1
If a(j) Mod 2 Then r = r + 2 ^ (n - j) Else r = r - 2 ^ (n - j)
Exit For
End If
Next
c(i) = b(r)
Next
[a1].Resize(10 ^ n) = WorksheetFunction.Transpose(c)
End Sub

复制代码

首先生成0-7这8种不同的奇偶类型对应字符，(二进制3位数的不同组合数=2^3-1=8-1=7)

然后计算每一个n位数 i 数值对应的奇偶换算值。

本代码和前面5楼第1段代码一开始的用法类似。但实现方法不同。

遗憾的是、速度并未提高。呵呵。

香川群子 · 发表于 2014-11-22 15:48

本帖最后由香川群子于 2014-11-22 15:49 编辑

如果不考虑通用性，固定n=3位，则上述算法的代码可以提高速度如下：

Sub test2() 'by kagawa 2014/11/22
Dim i&, i1&, i2&, i3&, s$, s1$, s2$
Dim a&(9), b$(1, 1, 1), c$(999)
For i = 1 To 9 Step 2
a(i) = 1
Next
s = "偶偶偶"
For i1 = 0 To 1
Mid(s, 1, 1) = IIf(i1, "奇", "偶")
For i2 = 0 To 1
Mid(s, 2, 1) = IIf(i2, "奇", "偶")
For i3 = 0 To 1
Mid(s, 3, 1) = IIf(i3, "奇", "偶")
b(i1, i2, i3) = s
Next i3, i2, i1
i = 0
For i1 = 0 To 9
For i2 = 0 To 9
For i3 = 0 To 9
c(i) = b(a(i1), a(i2), a(i3)): i = i + 1
Next i3, i2, i1
[c1].Resize(1000) = WorksheetFunction.Transpose(c)
End Sub

复制代码

首先、生成8种奇偶类型，然后直接3层循环得到结果……免去所有Mod计算。

		自动登录	找回密码
密码			注册