|
发表于 2014-11-21 15:38
|
显示全部楼层
本楼为最佳答案
- Sub 判断奇偶1()
- ts = Timer
- Dim arr, i&, j%, s$$, z$$
- Dim brr(0 To 111, 0 To 111, 0 To 111)
- brr(0, 0, 0) = "偶偶偶": brr(0, 0, 1) = "偶偶奇": brr(0, 1, 0) = "偶奇偶": brr(0, 1, 1) = "偶奇奇"
- brr(1, 0, 0) = "奇偶偶": brr(1, 0, 1) = "奇偶奇": brr(1, 1, 0) = "奇奇偶": brr(1, 1, 1) = "奇奇奇"
- Dim t(1 To 3) As Byte
- arr = Range("b6").CurrentRegion
- For i = 1 To UBound(arr)
- z = arr(i, 1)
- For j = 1 To 3: t(j) = Mid(z, j, 1) Mod 2: Next
- arr(i, 1) = brr(t(1), t(2), t(3))
- Next
- Range("F6:F60000").ClearContents
- [f6].Resize(UBound(arr)) = arr
- [f5] = Timer - ts
- End Sub
- Sub 判断奇偶2()
- ts = Timer
- Dim arr, i&, j%, s$$, z$$
- Set d = CreateObject("scripting.dictionary")
- For i = 0 To 9: d(i) = IIf(i Mod 2, "奇", "偶"): Next
- arr = Range("b6").CurrentRegion
- For i = 1 To UBound(arr)
- z = arr(i, 1): s = ""
- For j = 1 To 3: s = s & d(Val(Mid(z, j, 1))): Next
- arr(i, 1) = s
- Next
- Range("F6:F60000").ClearContents
- [f6].Resize(UBound(arr)) = arr
- [f5] = Timer - ts
- End Sub
- Sub 判断奇偶3()
- ts = Timer
- Dim arr, i&, j%, s$$, z%
- 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
- arr = Range("b6").CurrentRegion
- For i = 1 To UBound(arr)
- z = arr(i, 1)
- arr(i, 1) = d1(z)
- Next
- Range("F6:F60000").ClearContents
- [f6].Resize(UBound(arr)) = arr
- [f5] = Timer - ts
- End Sub
复制代码 速度都差不多,我的电脑都在0.5秒左右 |
|