[已解决]对字典基本用法的提速

爱疯

xdwy81129 发表于 2014-1-14 13:15
测试了下，改用  If d(B(i, 1)) + 1 = 1 Then  来判断，结果是24秒
楼主原来的是19.3秒

谢谢xdwy!
我没理解你的修改，不知完整代码是怎样的？
我觉得如果不大改，速度效果不明显。


名称:Intel(R) Pentium(R) CPU G2020 @ 2.90GHz
主频:2900Hz

amesman

excel里用vba的话也就这样的速度了，如果你真想再提速，可以用vb封装成dll，速度会有所提升，或者考虑用vb.net的多线程。。。。。。

爱疯

amesman 发表于 2014-1-14 15:42
excel里用vba的话也就这样的速度了，如果你真想再提速，可以用vb封装成dll，速度会有所提升，或者考虑用vb. ...

谢谢amesman！

我现在只是顺便打听一下。
等适当时候，再了解你说的这些高级东东

xdwy81129

爱疯 发表于 2014-1-14 15:12
谢谢xdwy!
我没理解你的修改，不知完整代码是怎样的？
我觉得如果不大改，速度效果不明显。

• 
  
      For i = 1 To UBound(A) '表1情况
          d(A(i, 1)) = 1
      Next
  
      For i = 1 To r
          If d(B(i, 1)) + 1 = 1 Then B(i, 1) = "无" Else B(i, 1) = "有"
      Next i
  
  
  
  
  英特尔（Intel）奔腾双核G2020 盒装CPU（LGA1155/2.9GHz/3M三级缓存/55w/22,这是你的cpu ，我查的，因为我也很关心计算速度，才狠心买的i5-3570,   3.4GHz的主频
  
  结果和你的速度基本一样，真不知道为什么我的这个cpu计算不快了
  
  
  

amesman

下午闲着没事，把你的代码用三种方法测试了一遍，我的电脑配置比较低
1. vba 法（楼主的代码没改动）：我的电脑耗时30秒（楼主只用了20秒，可以看出我的电脑真的是out了）；
2. vb封装楼主的代码为dll文件，然后在excel调用，耗时约27秒（提速不明显）；
3. VSTO法（vs2010之vb.net），代码适当改动，主要是为了适应vb.net的语法，代码逻辑及思路未变，耗时11秒（提速是相当的明显）；
另：尝试了一下多线程（创建了两个），耗时约8秒（略有提速）。
如果换成楼主的电脑，以上费时应当会有所缩短

爱疯

amesman 发表于 2014-1-16 22:41
下午闲着没事，把你的代码用三种方法测试了一遍，我的电脑配置比较低
1. vba 法（楼主的代码没改动）： ...

谢谢！
虽然自己不懂，但像看到目标，在遥远的地方。。。。{:021:}

xdwy81129

amesman 发表于 2014-1-16 22:41
下午闲着没事，把你的代码用三种方法测试了一遍，我的电脑配置比较低
1. vba 法（楼主的代码没改动）： ...

另：尝试了一下多线程（创建了两个），耗时约8秒（略有提速）


求教下，这句话怎么理解及怎么操作，谢谢你，不知道创建2个什么？感谢赐教

amesman

xdwy81129 发表于 2014-1-17 01:00
另：尝试了一下多线程（创建了两个），耗时约8秒（略有提速）

这位老兄深夜1点发贴，敬佩中。。。
是这样的，楼主的代码限速步骤其实是在匹配数组B的循环上（我分步测试下，其占时约为整个步骤的2/3），因此，多线程的操作就是把B数组进行拆分成两个数组，中间切，由此形成两个sub，每个sub一个线程，而字典的统计则为公共步骤。
昨天的测试有些匆忙，今天优化了下，多线程耗时约为2秒（不超过3秒），由此观之，若拆分的数组越多，即线程越多，则耗时会更少（再加上楼主高配的电脑。。。。。。{:101:}）。以下是部分代码，有兴趣的朋友可以去测试下：
注：定义一个pubic的字典

1. '拆分的两个sub
   
2. Sub Pp1()
   
3. Dim B As Array, i As Long, iRow As Long, MidRow As Long
   
4. iRow = Globals.Sheet2.Range("A" & Globals.Sheet2.Rows.Count).End(3).Row
   
5. MidRow = Int(iRow / 2)
   
6. B = Globals.Sheet2.Range("a1:a" & MidRow).Value
   
7. 
   
8. For i = 1 To UBound(B)
   
9. If d.ContainsKey(B(i, 1)) Then B(i, 1) = "有" Else B(i, 1) = "无"
   
10. Next i
    
11. Globals.Sheet2.Range("b1:b" & MidRow).Value = B
    
12. End Sub
    
13. 
    
14. Sub Pp2()
    
15. Dim B As Array, i As Long, iRow As Long, MidRow As Long
    
16. iRow = Globals.Sheet2.Range("A" & Globals.Sheet2.Rows.Count).End(3).Row
    
17. MidRow = Int(iRow / 2)
    
18. B = Globals.Sheet2.Range("a" & MidRow + 1 & ":a" & iRow).Value
    
19. 
    
20. For i = 1 To UBound(B)
    
21. If d.ContainsKey(B(i, 1)) Then B(i, 1) = "有" Else B(i, 1) = "无"
    
22. Next i
    
23. Globals.Sheet2.Range("b" & MidRow + 1 & ":b" & iRow).Value = B
    
24. End Sub
    
25. '以下是按键部分代码：
    
26. Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
    
27. Dim Start, Finish, TotalTime As Double
    
28. Start = Microsoft.VisualBasic.DateAndTime.Timer
    
29. Dim A As Array, i As Long
    
30. 
    
31. Me.Application.ScreenUpdating = False
    
32. A = Globals.Sheet1.Range("a1").CurrentRegion.Value
    
33. 
    
34. For i = 1 To UBound(A)
    
35. d(A(i, 1)) = ""
    
36. Next i
    
37. 
    
38. Dim t1 As Threading.Thread
    
39. Dim t2 As Threading.Thread
    
40. t1 = New Threading.Thread(AddressOf Me.Pp1)
    
41. t2 = New Threading.Thread(AddressOf Me.Pp2)
    
42. 
    
43. t1.Start()
    
44. t2.Start()
    
45. 
    
46. Finish = DateTime.Now.ToOADate()
    
47. TotalTime = Microsoft.VisualBasic.DateAndTime.Timer - Start
    
48. MsgBox("耗时： " & Format(TotalTime, "0.00") & " 秒!")
    
49. Me.Application.ScreenUpdating = True
    
50. End Sub

复制代码

xdwy81129

amesman 发表于 2014-1-17 15:33
这位老兄深夜1点发贴，敬佩中。。。
是这样的，楼主的代码限速步骤其实是在匹配数组B的循环上（我分步测 ...

大侠，上个附件吧，我把你的代码放到模块里，出现红色的错误，如图

其中有一个错误是： As Array，这个不知道怎么解决
其他红色的地方还恳请大侠指教

amesman

xdwy81129 发表于 2014-1-17 17:09
大侠，上个附件吧，我把你的代码放到模块里，出现红色的错误，如图

其中有一个错误是： As Array，这个 ...

老兄，用VSTO开发，不是Vba!