`
cjc
  • 浏览: 659423 次
  • 性别: Icon_minigender_1
  • 来自: 北京
社区版块
存档分类
最新评论
文章列表
快速组合数C(N,K)=N*(N-1)*(N-2)*...*(N-K+1)/1*2*3*...*K  的求法:    Function ZDGYS(ByVal x As Long, ByVal y As Long) As Long 'GET Greatest Common Divisor最大公约数     Dim TEMP As Long    If x > y Then TEMP = x: x = y: y = TEMP   'LET X < Y   Do      TEMP = y Mod x      If TEMP = 0 Then ZDGYS = x: Exit Funct ...
下面的算法在 http://www.csdn.net/Develop/Edit.asp?id=28308基础上改进,比其至少快10%: Sub calcfactorial(ByVal n As Integer)Dim XYS() As Integer, x() As Integer, y() As Integer, result() As String, i As Long, j As Long, k As Long, TEMP As Long, stimer As DoubleIf n < 0 Then Exit SubReDim x(1)ReDim XYS(1)x(1) = 1XYS( ...
今天整理文件时发现了以前写的货币金额中文转换(转换一亿亿元以下数目的货币)的代码,帖出来与大家共享:   Function daxie(money As String) As String 'Dim x As String, y As StringConst zimu = ".sbqwsbqysbqwsbq" '定义位置代码Const letter = "0123456789sbqwy.zjf" '定义汉字缩写Const upcase = "零壹贰叁肆伍陆柒捌玖拾佰仟萬億圆整角分" '定义大写汉字Dim temp As Stringte ...
整数n的阶乘指 1*2*3*...*(n-1)*n 的值,在n=171时,计算机一般会出错(“溢出”),本文采用字符串模拟数字乘法运算,使计算10000!成为可能: Function multi(ByVal X As String, ByVal Y As String) As String 'multi of two huge hexnum(两个大数之积)Dim result As VariantDim xl As Long, yl As Long, temp As Long, i As Longxl = Len(Trim(X))yl = Len(Trim(Y)) ReDim result(1 ...
http://expert.csdn.net/Expert/topic/3105/3105509.xml?temp=.1253168 与笔者的另一算法(http://www.csdn.net/Develop/read_article.asp?id=28306)相比,采用下面的方法,阶乘的计算速度快了好几倍!   Sub calcfactorial(ByVal n As Integer)Dim XYS() As Integer, x() As Integer, ...
下面的代码可以将任意日期(1000-01-01------>9999-12-31)转换为汉字显示:   Private Sub Command1_Click()MsgBox datename(Date)End SubFunction datename(ByVal mydate As Date) As StringDim i As Long, d(3) As String, myyear As Stringmyyear = Format(mydate, "yyyy")For i = 1 To 4d(0) = d(0) & Mid("○一二三四五六七八九& ...
对于一般的整型数字,16进制与10进制 间的转化可以用CLNG(),HEX()函数解决,但遇上天文数字,这些函数就无能为力了。下面是笔者写的几个函数,演示了天文数字计算中的一些技巧。 Dim largehex As String, largedec As String, start As Long, Y(20) As String '预备函数Function sums(ByVal X As String, ByVal Y As String) As String ' sum of two hugehexnum(两个大数之和)Dim max As Long, temp As Long, I As ...
      文本框属性为允许多行显示时,由于是软回车实现的分行,无法用SPLIT(TEXT1.TEXT,VBCRLF)准确地取出指定行的内容。本文利用SENDMESSAGE 系列函数,通过发送文本框消息,实现了获取包含指定字符串的行,并演示了如何获取文本框中文本总行数和任意指定行的文本内容。 'add a textbox with "multiline=true","scrollbars=2". Private Declare Function SendMessage Lib "USER32" Alias "SendMessa ...
     如何计算给定的字符串计算表达式,如“ 1+2*3-4/5+ 6^7” 的值?笔者在使用EXCEL2002 时发现在单元格中可以输入此类表达式,输出的则是计算结果,所以写了一个函数,与大家共享。   '引用microsoft excel 10.0 object library( OR OTHER VERSION)' add a textbox and a commandbutton to form1Function result(ByVal x As String)Dim myobj As ObjectSet myobj = CreateObject("excel.sheet& ...
笔者曾写过一个递归与组合的算法(http://www.csdn.net/Develop/read_article.asp?id=23809),下面给出一个排列的递归算法,请大家指教。 Private Sub Command1_Click() ' 列出数组a 的全排列Dim a(8) As String, temp As StringFor i = 0 To 8a(i) = iNexttemp = permutation(a, UBound(a))Debug.Print tempDebug.Print "共有 " & UBound(Split(temp, vbCrLf) ...
下面实现字符串表达式计算代码由笔者收藏的本论坛代码改编,记不清是哪位网友提供的了,非常感谢。 Option ExplicitPrivate Declare Function EbExecuteLine Lib "vba6.dll" (ByVal pStringToExec As Long, ByVal Unknownn1 As Long, ByVal Unknownn2 As Long, ByVal fCheckOnly As Long) As Long Private Function ExecuteLine(sCode As String, Optional fCheck ...
       动态数组在VB语言中常能起到出奇制胜的作用。但数组有没有被重新定义或释放,用“is empty”,“is null”,“=" "”等方法都不起作用。所以判断时一般采用侦别错误消息(ON ERROR )的方法。下面给出一个非错误侦别的代码,判断动态字符串数组的分配情况:   Private Sub Command1_Click()Dim a() As String, i As Long MsgBox hasredim(a), 64, "Has a() been redimed?"   '未初始化 ReDim a(20) For i = 1 To ...
一个运用API 更改系统菜单,复制系统菜单的例子。(需要注意的是:如果要响应菜单项的单击事件,可能要用到钩子函数和更多的代码) Option Explicit Private Declare Function TrackPopupMenu Lib "user32" (ByVal hMenu As Long, ByVal wFlags As Long, ByVal x As Long, ByVal y As Long, ByVal nReserved As Long, ByVal hwnd As Long, ByVal lprc As Any) As LongPrivate D ...
       福利彩票和体育彩票近两年比较火暴,相应在VB论坛上大家讨论也较多。其实选择彩票与集合选择子集相同道理。下面给出一种VB的递归算法(虽然明知存入数组会加快运算速度,但最终也没能满意地实现,请大家多多指教。另外,效率确实不高)Option Explicit Private Sub Command1_Click() Dim temp, i As Long, starttime As Long, endtime As Longstarttime = Timertemp = cmn(22, 6)endtime = TimerOpen "d:\mofn.txt" For B ...
     一个简单的API语句可以实现更改菜单字体颜色:Private Declare Function SetSysColors Lib "user32" (ByVal nChanges As Long, lpSysColor As Long, lpColorvalues As Long) As LongPrivate Sub Form_Load()  SetSysColors 1, 7, vbRed '设置菜单字体红色(可选择 &H0 -----> &HFFFFFF 共16777216种颜色!)End Sub Private Sub Form_Unl ...
Global site tag (gtag.js) - Google Analytics