Excel实例下载
  VBA  应用教程
    数据库SQL知识
设为首页
利用VBA列出真分数
作者:plz001 | 来源:Excel精英培训网 | 时间:2007-04-06 | 阅读权限:游客 | 会员币:0 | 【

这是Excel精英培训网VBA接力赛第1期:

http://www.excelpx.com/dispbbs.asp?boardid=96&replyid=68094&id=13767&page=1&skin=0&Star=1

出题者:qee用。

题目要求:
1.在B1单元格输入一整数(约定2-300之间),在A列从小到大显示分母小于或等于该整数的所有不可约的真分数。
2.代码需要必要的注释。 
 
评价标准: 
在代码正确的基础的上,以运行速度为第一评价要素。

优胜代码作者:plz001

优代胜代码如下:

Sub CommandButton1_Click()
    Application.ScreenUpdating = False
    M = Timer
    Columns("A:A").ClearContents
    Columns("A:A").NumberFormatLocal = "# ???/???"
    v = Cells(1, 2)
    If v = 2 Then [a1] = 0.5: Exit Sub
    r = 0                 '在数组中生成分数列,速度快
    ReDim arrl(1 To (v * (v - 1) / 2), 0)
    For i = 2 To v
        For t = 1 To i - 1
            r = r + 1
            arrl(r, 0) = t / i
        Next t
    Next i
    Range("A1:A" & r) = arrl
    Set arr = Range("a1:a" & r)   '对对象变量的操作比直接访问对象速度快
    arr.Sort Key1:=arr(1, 1), Order1:=xlAscending, Header:=xlNo
    rng1 = arr       '?????
    ReDim ary(1 To r, 0)         '排序后再筛选,这样的算法快
    ary(1, 0) = rng1(1, 1)
    For i = 2 To r
        If rng1(i, 1) <> rng1(i - 1, 1) Then
            ary(k + 2, 0) = rng1(i, 1)
            k = k + 1
        End If
    Next i
    Range("A1:A" & r) = ary
    Application.ScreenUpdating = True
    MsgBox Timer - M
End Sub

点评:

这是前段时间在“编程爱好者”论坛看到的一道C语言题,本来是想考核大家排序算法的,发题时有些匆忙,既忽略了EXCEL自身的排序功能,更忘了EXCEL中的“分数”格式,真是惭愧。也好,EXCEL有EXCEL的精彩,感谢所有参与的朋友提供的精彩答案。因为排序已不是本题的重点,影响速度的主要因素就变成了两个方面:
1.数组的使用
VBA在对大数据的处理中,为了提高代码速度,数组是经常使用的方法。很多朋友对数组的方法可能还不熟悉,来看下面的例子:
dim i&
for i=1 to 10000
  cells(i,2)=cells(i,1)*i
next i
上面这段代码是将[A1]至[A10000]依次写入[A1]至[A10000]乘它们所在的行号,如果使用数组的方法,就是这样的:
dim i&,arr1(),arr2(1 to 10000,1 to 1)
arr1=range("A1:A10000") ’将数据读入数组,当将超过1个单元格区域的数据读入Variant型变量时,便会产生一个下标从1开始的二维数组,两维分别对应行和列
for i=1 to 10000 
  arr2(i,1)=i*arr1(i,1) ’从数组中读数计算比从工作表中读数快得多
next i
range("B1:B10000")=arr2 ’处理完成后,一次性写回工作表比逐个写快N倍
你只要记住上面注释的三行并学会应用,差不多就掌握了80%以上的数组知识。
2.最大公约数
Function Gys(ByVal a%, ByVal b%)
  If a Mod b = 0 Then Gys = b: Exit Function
  Gys = Gys(b, a Mod b)
End Function

我的感悟:

没有天生的高手,不断的学习与不断的探索,对待事情精义求精,才会进步,回想起这段时间的人生经历,感觉——态度决定一切!(以上内容整理由Excel吧

文章录入:admin | 浏览次数:
相关评论(以下网友评论只代表其个人观点,不代表Excel吧的观点或立场)
相关信息

关于本站 | 留言本站 | 友情连接 | 后台管理
Copyright © 2005 - 2008 Excel吧 Inc. All Rights Reserved.
HxCms Ver9.0  闽ICP备06001689号
关闭此窗口