Excel精英培训网

 找回密码
 注册
数据透视表40+个常用小技巧,让你一次学会!
查看: 6073|回复: 23

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

[复制链接]
发表于 2014-11-21 12:21 | 显示全部楼层 |阅读模式
本帖最后由 yslvictor 于 2014-11-22 00:59 编辑

求某一列3个数字字符的奇偶性(这是论坛老师提供的)。
数据有5万多行,运行时速度太慢,如果表内再有其他数据时,速度更慢,请教老师有没有还能提高速度的代码。
原代码:
Sub 判断奇偶()
Range("E6:F" & Range("B65536").End(xlUp).Row).ClearContents
ts = Timer
Dim arr, i, j, s, t
arr = Range("b6", Range("b65536").End(xlUp))
For i = 1 To UBound(arr)
    For j = 1 To 3
            If Mid(arr(i, 1), j, 1) Mod 2 Then
                t = "奇"
            Else
                t = "偶"
            End If
        s = s & t
    Next
    arr(i, 1) = s
    s = ""
Next
Range("F6:F" & Range("B65536").End(xlUp).Row).ClearContents
[f6].Resize(UBound(arr)) = arr
[f5] = Timer - ts
End Sub
图片.jpg
判断奇偶.rar (473.92 KB, 下载次数: 19)
发表于 2014-11-21 12:53 来自手机 | 显示全部楼层
你运行5w是多久?
不作连接可以吗?改成n行3列的数组装结果
不用奇偶用1和0表示行吗?
回复

使用道具 举报

发表于 2014-11-21 13:33 | 显示全部楼层
运行速度和电脑有关,我的机器2s左右
优化了一下,提速空间不大
  1. Sub 判断奇偶()
  2. ts = Timer
  3. Dim arr, i&, j%, s$$, z$$, t$$
  4. arr = Range("b6").CurrentRegion
  5. For i = 1 To UBound(arr)
  6.     z = arr(i, 1): s = ""
  7.     For j = 1 To 3
  8.         If Mid$$(z, j, 1) Mod 2 Then t = "奇" Else t = "偶"
  9.         s = s & t
  10.     Next
  11.     arr(i, 1) = s
  12. Next
  13. Range("F6:F60000").ClearContents
  14. [f6].Resize(UBound(arr)) = arr
  15. [f5] = Timer - ts
  16. End Sub
复制代码
回复

使用道具 举报

 楼主| 发表于 2014-11-21 13:39 | 显示全部楼层
爱疯 发表于 2014-11-21 12:53
你运行5w是多久?
不作连接可以吗?改成n行3列的数组装结果
不用奇偶用1和0表示行吗?

你好老师,我的电脑配置不算高,5万多行大约5秒多吧,这个表中再有一些别的数据的话,有一次运行了5分钟,按表中要求,就只有一列填充。就想用奇偶,但用字母J、O也行,谢谢。
回复

使用道具 举报

发表于 2014-11-21 15:38 | 显示全部楼层    本楼为最佳答案   
  1. Sub 判断奇偶1()
  2. ts = Timer
  3. Dim arr, i&, j%, s$$, z$$
  4. Dim brr(0 To 111, 0 To 111, 0 To 111)
  5. brr(0, 0, 0) = "偶偶偶": brr(0, 0, 1) = "偶偶奇": brr(0, 1, 0) = "偶奇偶": brr(0, 1, 1) = "偶奇奇"
  6. brr(1, 0, 0) = "奇偶偶": brr(1, 0, 1) = "奇偶奇": brr(1, 1, 0) = "奇奇偶": brr(1, 1, 1) = "奇奇奇"
  7. Dim t(1 To 3) As Byte
  8. arr = Range("b6").CurrentRegion
  9. For i = 1 To UBound(arr)
  10.     z = arr(i, 1)
  11.     For j = 1 To 3: t(j) = Mid(z, j, 1) Mod 2: Next
  12.     arr(i, 1) = brr(t(1), t(2), t(3))
  13. Next
  14. Range("F6:F60000").ClearContents
  15. [f6].Resize(UBound(arr)) = arr
  16. [f5] = Timer - ts
  17. End Sub


  18. Sub 判断奇偶2()
  19. ts = Timer
  20. Dim arr, i&, j%, s$$, z$$
  21. Set d = CreateObject("scripting.dictionary")
  22. For i = 0 To 9:  d(i) = IIf(i Mod 2, "奇", "偶"): Next
  23. arr = Range("b6").CurrentRegion
  24. For i = 1 To UBound(arr)
  25.     z = arr(i, 1): s = ""
  26.     For j = 1 To 3: s = s & d(Val(Mid(z, j, 1))): Next
  27.     arr(i, 1) = s
  28. Next
  29. Range("F6:F60000").ClearContents
  30. [f6].Resize(UBound(arr)) = arr
  31. [f5] = Timer - ts
  32. End Sub

  33. Sub 判断奇偶3()
  34. ts = Timer
  35. Dim arr, i&, j%, s$$, z%
  36. Set d = CreateObject("scripting.dictionary")
  37. Set d1 = CreateObject("scripting.dictionary")
  38. For i = 0 To 9:  d(i) = IIf(i Mod 2, "奇", "偶"): Next
  39. For i = 0 To 999
  40.     t1 = i \ 100: t2 = (i - t1 * 100) \ 10: t3 = Val(Right(i, 1))
  41.     d1(i) = d(t1) & d(t2) & d(t3)
  42. Next
  43. arr = Range("b6").CurrentRegion
  44. For i = 1 To UBound(arr)
  45.     z = arr(i, 1)
  46.     arr(i, 1) = d1(z)
  47. Next
  48. Range("F6:F60000").ClearContents
  49. [f6].Resize(UBound(arr)) = arr
  50. [f5] = Timer - ts
  51. End Sub
复制代码
速度都差不多,我的电脑都在0.5秒左右
回复

使用道具 举报

发表于 2014-11-21 16:00 | 显示全部楼层
如果数据量再大一点,个人觉得第3种方法可能最快
回复

使用道具 举报

发表于 2014-11-21 16:01 | 显示全部楼层
事先生成000-999这 1000个数值的奇偶判断结果,存入数组a(999)。
然后5万行或更多数据的检查,只需用数组比对即可返回结果。

回复

使用道具 举报

发表于 2014-11-21 16:44 | 显示全部楼层
不考虑输出到工作表的时间,5万行计算比较运算只要0.05秒。
  1. Sub test() 'by kagawa 2014/11/21
  2.     Dim arr, i&, j&, k&, n&, s$, s1$, s2$, tms#
  3.     tms = Timer
  4.    
  5.     n = 3: ReDim a&(1 To n)
  6.     s1 = ChrW(22855) '"奇"
  7.     s2 = ChrW(20598) '"偶"
  8.     s = String(n, s2)
  9.     k = 10 ^ n - 1: ReDim b$(k): b(0) = s
  10.    
  11.     For i = 1 To k
  12.         For j = n To 1 Step -1
  13.             If a(j) = 9 Then
  14.                 a(j) = 0: Mid(s, j, 1) = s2
  15.             Else
  16.                 a(j) = a(j) + 1: If a(j) Mod 2 Then Mid(s, j, 1) = s1 Else Mid(s, j, 1) = s2
  17.                 Exit For
  18.             End If
  19.         Next
  20.         b(i) = s
  21.     Next
  22.    
  23.     arr = [b6].CurrentRegion
  24.     For i = 1 To UBound(arr)
  25.         arr(i, 1) = b(arr(i, 1))
  26.     Next
  27.     [f1] = Format(Timer - tms, "0.000")
  28.    
  29.     [f6].CurrentRegion = ""
  30.     [f6].Resize(UBound(arr)) = arr
  31.     MsgBox Format(Timer - tms, "0.000s")
  32. End Sub
复制代码

JO.zip

571.95 KB, 下载次数: 10

回复

使用道具 举报

发表于 2014-11-21 16:46 | 显示全部楼层
我的算法是通用的……可以把n改成任意位数……比如n=5就可以判断5位数值的奇偶类型。
回复

使用道具 举报

发表于 2014-11-21 17:10 | 显示全部楼层
3楼、5楼、8楼代码速度比较(仅比较计算,不含输出)
其实目前输出才是耗时最大的部分,但这个没办法优化的。


Run Count: 10 连续运算10次的。
test 1 : 3.1832s 3楼
test 2 : 3.5373s 5楼-1
test 3 : 6.1692s 5楼-2
test 4 : 2.4435s 5楼-3
test 5 : 1.6128s 8楼 kagawa
--End--

回复

使用道具 举报

您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|Archiver|Excel精英培训 ( 豫ICP备11015029号 )

GMT+8, 2024-3-28 18:02 , Processed in 1.038090 second(s), 14 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

快速回复 返回顶部 返回列表