[VBA接力赛第1期]真分数[已总结]

element

<p>恭喜诸位 </p>[em23][em17]

lpz001

<p><span lang="EN-US">qee</span>用大师，您饶了我吧，我只不过是新来的菜鸟，您让我出题，真是难为死我了！我放弃出题权。<span lang="EN-US"><p></p></span></p><p>我就只谈下我的参赛经历吧。我的第一稿，纯粹只为了参与，用的是<span lang="EN-US">EXCEL</span>自带的排序和高级筛选功能，只求完成，不求速度。第二稿，是我在<span lang="EN-US">Home</span>中搜来的高人之作，利用先排序后筛选的算法，并运用数组，使得速度大大提高。同时我也尝试了使用集合的方法来进行筛选，由于对数组和集合一知半解，并未成功！于是我在其它版面发出了提问，请求<span lang="EN-US">qee</span>用大师给于解答，在此我再次感谢<span lang="EN-US">qee</span>用大师的精辟解答！第三稿时，我利用数组生成分数序列，再次提高了速度。一路走来，我想的就是能不能再快一点，再快一点！我借前人之用，我不懂就问，提高真得比较快！<span lang="EN-US"><p></p></span></p><p>其实我知道，我钻了很大的漏洞，第一稿时我还在窃喜，版主并未要求不能用<span lang="EN-US">EXCEL</span>自带的排序和筛选功能呀，看了别人的大作，我真的很汗颜，做学问真的需要一丝不苟，提高是自己的。<span lang="EN-US">uranus1997</span>的最大公约数函数，递归的运用将是我最好的学习！同时<span lang="EN-US">qee</span>用大师对我的提点，我将铭记在心，以求尽善尽美！</p><p>我放弃出题权，我自认我还没有这个资格</p><p>[em04]</p><p></p>

lpz001

最棒还是qee用大师，您接着给我们出题吧！[em04]

uranus1997

<p>赛后向朋友请教了一下VBA类解释性语言的工作原理, 发现这真是提速的关键. 因为VBA是解释执行, 不是CPU直接执行, 这样就会慢了一步, 所以要提速就要尽量调用内部程序或函数直接向CPU发执行指令, 尽量减少解释的次数. 搜了一下关于VBA提速的技巧, 大部分都是遵循这个原则......</p>

qee用

<div class="msgheader">QUOTE:</div><div class="msgborder"><b>以下是引用<i>uranus1997</i>在2007-3-19 21:21:45的发言：</b><br/><p>赛后向朋友请教了一下VBA类解释性语言的工作原理, 发现这真是提速的关键. 因为VBA是解释执行, 不是CPU直接执行, 这样就会慢了一步, 所以要提速就要尽量调用内部程序或函数直接向CPU发执行指令, 尽量减少解释的次数. 搜了一下关于VBA提速的技巧, 大部分都是遵循这个原则......</p></div><p></p>谢谢<strong><em>uranus1997</em></strong>.

qee用

<p>呵呵，我有时也想，大家在论坛上主要是交流学习的，我们无意和谁一比高低，是不是叫竟赛会给人一种的不好感觉呢，但实在想不出更合适的叫法，我们姑且叫它竞赛。参与是因为这是让我们愉快的交流方式之一，规则只是让我们的快乐可以延续下去而已。每段代码带给我的感受都是勇气、宽容、分享和智慧。<br/>哪有什么绝对好的代码啊？<br/>有一个老师曾经举过一个例子，代码是完成在[A1：A5]单元格区域分别填入1-5：<br/>sub FillA1A5()<br/>&nbsp; [a1]=1<br/>&nbsp; [a2]=2<br/>&nbsp; [a3]=3<br/>&nbsp; [a4]=4<br/>&nbsp; [a5]=5<br/>end sub<br/>按照一般的评价，上面的代码以5分制大家会打几分？如果我告诉你这是一个专业高手写的，你又会打几分？又有谁能解释为什么要这么写吗？（呵呵，留给思考题了，但其实不会有标准答案）真正的高手，是需要宽容的，这种宽容是一种大智慧。本次竞赛有我们的3位版主参与，他们是01班群中公认的高手，我从出题到答案，全部注意力都集中在“堆排序”上，出题的第一天，我还在津津有味地优化我的排序呢，说这些，是想让大家包括你我都不要有什么负担，如果一定有人在笑，让他笑好了。规则中所以先写目的，所以说不需要公布评价的规则，也是因为这些，因为每份答案都有她的美丽。至于对比赛的结果，说喜，说忧，说难，说易，说不服，只要高兴就好，但在我们心底，是心照不宣的微笑。<br/>说回来，出题也是对自己的一种锻炼呢，我在刚开始的时候，也有顾虑重重，瞻前顾后，慢慢地熟悉了就好了，只是有时要把问题表达清楚，又口齿不清，写题很累想偷懒倒是真的，VBA的题材很丰富哦。如果7天的时间不够，可以多一些时间，千万别再说放弃哦，我们的接力才刚开始。<br/>我很期待。</p><p></p>

戏子

<p>汗~~我怎么没有想起用SQL进行筛选呢?</p><p>Application.ScreenUpdating = False<br/>Dim cn As New ADODB.Connection<br/>cn.Open "provider=microsoft.jet.oledb.4.0;extended properties=excel 8.0;data source=" &amp; ThisWorkbook.FullName<br/>t = Timer<br/>n = [b1]<br/>Dim arr(1 To 32768, 1 To 1)<br/>Range("A1:A" &amp; [A65536].End(xlUp).Row).ClearContents<br/>m = 1<br/>For i = 1 To n<br/>&nbsp;&nbsp;&nbsp; For j = 1 To i - 1<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; arr(m, 1) = j / i<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; <br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; m = m + 1<br/>&nbsp;&nbsp;&nbsp; Next j<br/>Next i<br/>[a1:a32768] = arr</p><p>Sql = "select f1 from [sheet1$]"<br/>Sheet1.Range("C1:C" &amp; [C65536].End(xlUp).Row + 1).ClearContents<br/>Sheet1.Range("C1").CopyFromRecordset cn.Execute(Sql)<br/>Sheet1.Range("C1:C" &amp; [C65536].End(xlUp).Row).Cut Sheet1.Range("A1")<br/>'//A列按升序排列<br/>&nbsp;&nbsp;&nbsp; Range("A1:A" &amp; [A65536].End(xlUp).Row).Select<br/>&nbsp;&nbsp;&nbsp; Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, _<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; :=xlPinYin, DataOption1:=xlSortTextAsNumbers<br/>Range("A:A").NumberFormatLocal = "# ???/???"<br/>tim = (Timer - t) * 1000<br/>MsgBox "共耗时:" &amp; tim &amp; "毫秒"<br/>cn.Close<br/>Set cn = Nothing<br/>Application.ScreenUpdating = True</p>

qee用

<div class="msgheader">QUOTE:</div><div class="msgborder"><b>以下是引用<i>戏子</i>在2007-3-19 22:49:28的发言：</b><br/><p>汗~~我怎么没有想起用SQL进行筛选呢?</p></div><p>哈,你又忘了,不光筛选,排序也可一并做了.</p>

戏子

<div class="msgheader">QUOTE:</div><div class="msgborder"><b>以下是引用<i>qee用</i>在2007-3-19 22:52:56的发言：</b><br/><div class="msgheader">QUOTE:</div><div class="msgborder"><b>以下是引用<i>戏子</i>在2007-3-19 22:49:28的发言：</b><br/><p>汗~~我怎么没有想起用SQL进行筛选呢?</p></div><p>哈,你又忘了,不光筛选,排序也可一并做了.</p></div><p>Sub sanbe()<br/>Application.ScreenUpdating = False<br/>On Error Resume Next<br/>Dim cn As New ADODB.Connection<br/>cn.Open "provider=microsoft.jet.oledb.4.0;extended properties=excel 8.0;data source=" &amp; ThisWorkbook.FullName<br/>t = Timer<br/>n = [b1]<br/>Dim arr(1 To 32768, 1 To 1)<br/>Range("A1:A" &amp; [A65536].End(xlUp).Row).ClearContents<br/>m = 1<br/>For i = 1 To n<br/>&nbsp;&nbsp;&nbsp; For j = 1 To i - 1<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; arr(m, 1) = j / i<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; <br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; m = m + 1<br/>&nbsp;&nbsp;&nbsp; Next j<br/>Next i<br/>[a1:a32768] = arr<br/>'//筛选不重复值并按升序排列<br/>Sql = "select f1 from [sheet1$] group by f1"<br/>Sheet1.Range("C1:C" &amp; [C65536].End(xlUp).Row + 1).ClearContents<br/>Sheet1.Range("C1").CopyFromRecordset cn.Execute(Sql)<br/>Sheet1.Range("A1:A" &amp; [A65536].End(xlUp).Row + 1).ClearContents<br/>Sheet1.Range("C1:C" &amp; [C65536].End(xlUp).Row).Cut Sheet1.Range("A1")<br/>Range("A:A").NumberFormatLocal = "# ???/???"<br/>tim = (Timer - t) * 1000<br/>MsgBox "共耗时:" &amp; tim &amp; "毫秒"<br/>cn.Close<br/>Set cn = Nothing<br/>Application.ScreenUpdating = True<br/>End Sub</p><p>VBA跟函数一样,还是思路第一啊 </p><p>不怕做不到,就怕想不到</p><p>这个题目有空还得仔细研究研究</p>[em04][em04]

[此贴子已经被作者于2007-3-19 23:17:25编辑过]

cfq-xxj

<p>我恨不得把他吃到肚子里!</p>