V中班课前必做题：找唯一

兰色幻想

这个题目的极限速度应该在0.3秒左右

HYY514

原来还有排行榜的啊[em01]

兰色幻想

<div class="msgheader">QUOTE:</div><div class="msgborder"><b>以下是引用<i>HYY514</i>在2008-7-7 16:20:00的发言：</b><br/>原来还有排行榜的啊[em01]</div><p>我把大家的代码都拷进我的电脑了[em01]</p><br/>

HYY514

<p>好啊,都总结起来了,期待共享</p>[em01][em01]

不看不看

<p>最近几天忙，过两天再学习学习大家的，偶的也再改改</p>[em01]

水击石穿

<p>我的VBA还需要修炼！！</p>[em01][em01]

劫-后-余-生

主体没变，仅细微处改了点，居然提高了0.3秒，本机上达到0.625.等答案……

HYY514

<p><br/>Sub fx2()<br/>Dim i As Long<br/>Dim j As Integer<br/>Dim ar<br/>Dim s As String<br/>Dim myi As Integer<br/>Dim CellRow<br/>Dim Cellid<br/>Dim ss As String<br/>Dim n As Integer<br/>Dim d As New Dictionary<br/>Dim ra As Range<br/>Dim bol As Boolean<br/>Dim boll As Boolean<br/>Dim t As Double</p><p>Application.ScreenUpdating = False<br/>t = Timer<br/>ar = Range("a1:a60000")<br/>For i = 1 To 60000 Step 200<br/>&nbsp;&nbsp;&nbsp; myi = myi + 1<br/>&nbsp;&nbsp;&nbsp; For j = 0 To 199<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; s = myi &amp; "-" &amp; ar(i + j, 1)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; If Not d.Exists(s) Then<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; d(s) = "a" &amp; i + j<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Else<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; d(s) = False<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; End If<br/>&nbsp;&nbsp;&nbsp; Next<br/>Next</p><p>CellRow = d.items<br/>Cellid = Filter(CellRow, False, False)</p><p>n = UBound(Cellid)</p><p>For i = 0 To n<br/>&nbsp;&nbsp;&nbsp; ss = ss &amp; Cellid(i) &amp; ","<br/>&nbsp;&nbsp;&nbsp; If i Mod 35 = 0 Or i = n Then<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; If bol Then<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Set ra = Union(ra, Range(Left(ss, Len(ss) - 1)))<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; If boll Then<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; With ra<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; .Font.ColorIndex = 5<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; .Interior.ColorIndex = 6<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; End With<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; bol = False<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; boll = False<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Else<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; boll = True<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; End If<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Else<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Set ra = Range(Left(ss, Len(ss) - 1))<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; bol = True<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; End If<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ss = ""<br/>&nbsp;&nbsp;&nbsp; End If<br/>Next</p><p>Application.ScreenUpdating = True<br/>MsgBox Timer - t<br/>End Sub</p>

HYY514

<p>滥用布尔值,速度又有改进</p>

戏子

<p>再来一次,速度上可以了,350MS,算法上没有什么突破了,就等兰版的精彩代码,比偶还快20[em03]</p><p>

游客，如果您要查看本帖隐藏内容请回复

</p><p></p>