- 博客(229)
- 收藏
- 关注
RSS订阅原创 The top 4 great outsourcing web
http://www.getacoder.comhttp://www.scriptlance.comhttp://www.getafreelancer.comhttp://www.rentacoder.com
2008-04-23 17:12:00
1006
1
转载 Can the msgbox vbYesNo button captions be changed in VBA?
Private sButton1 As StringPrivate sButton2 As StringPrivate sCaption As StringPrivate sText As StringPrivate Const MB_ICONQUESTION As Long = &H20&Private Const MB_OKCANCEL As Long = &H1&Private Const
2007-12-06 00:31:00
3180
原创 Colour unique formulae and constant cells of all sheets of activeworkbook
A question in http://www.mrexcel.com/board2/viewtopic.php?t=304750I am looking for a macro which does two things: 1. colours all constants in a workbook as yellow. 2. colours all formulae with purpl
2007-12-06 00:16:00
1038
原创 Do you know how many combinations to select n numbers from 1 to m with sum of which is mysum?
Do you know how many combinations to select n numbers from 1 to m with sum of which is sum?Sub getit()Dim m&, n&, mysum&, i&, j&, k&, count()m = 100: n = 30: mysum = 700ReDim count(m, n, -mysum T
2007-12-03 00:37:00
1656
原创 递归实现数字排列组合
参考彭希仁的递归算法Sub macro1()Dim arr() As Stringgetall 9, 3, "", arrDebug.Print Join(arr, ",")End SubSub getall(ByVal m As Byte, ByVal n As Byte, ByRef a As String, ByRef arr() As String, Optional ByRef co
2007-10-30 16:33:00
2644
原创 自动获取美元最新汇率
Sub MACRO1()With CreateObject("Msxml2.XMLHTTP").Open "GET", "http://www.google.cn/search?&q=1usd%3D%3Frmb", False.SendMsgBox Split(Split(.responseText, "1美元 =")(1), "人民币")(0)End WithEnd Sub
2007-10-11 23:43:00
3115
原创 3D历史数据下载
Sub Macro1()Application.ScreenUpdating = FalseDim temp() As String, n As Long, i As LongWith CreateObject("InternetExplorer.Application").Visible = True.navigate "http://www.cpkc.net/3d/3dwz1-0.htm
2007-10-05 18:42:00
5707
原创 Save an userform as an image in EXCEL
When click a commandbutton in an Excel userform,save the entire userform as an image file in harddisk.Method 1Private Declare Sub Keybd_Event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte,
2007-10-04 18:17:00
4124
原创 Adding checkbox to mshflexgrid
Private Sub MSHFlexGrid1_Click()If MSHFlexGrid1.Col = 0 Then MSHFlexGrid1.Text = Chr(124 - Asc(MSHFlexGrid1.Text))End SubPrivate Sub Form_Load() Dim i As LongWith MSHFlexGrid1.FixedCols = 0.Cols = 4
2007-10-04 02:11:00
1826
转载 香辣虾的做法
1.虾一份,洗净待用750) this.width=750" />2.准备香料如图: 葱,姜,蒜,干辣椒,花椒750) this.width=750" />3.热油,爆炒花椒,辣椒,一些姜丝(留一点和虾一起炒)750) this.width=750" />4. 做好3之后,倒入虾,葱,姜丝,蒜片一起炒750
2007-10-03 15:09:00
1696
转载 美味带鱼的家常做法
带鱼是最经济美味的食品，现向大家推荐几种带鱼的做法。 红烧带鱼红烧带鱼 制 作： 1.带鱼清洁干净，切6公分左右段，用少许盐，料酒，略腌制15分钟。 2.取一个干净小碗，放入葱，姜，蒜，少许盐，少许糖，料酒，水淀粉待用。 3.取另一个小碗，放入一个鸡蛋搅拌均匀待用。 4.炒锅放油，待到8成熟，放入两片姜，将腌好的带鱼裹上鸡蛋放入油锅内煎至金黄。
2007-10-03 14:27:00
2103
2
原创 VBA自动登陆163信箱
Sub Goto163()With CreateObject("InternetExplorer.Application").Visible = True.navigate "http://mail.163.com"Do Until .Readystate = 4DoEventsLoop.Document.Forms(0).All(9).Value = "myusername".Document
2007-10-01 18:22:00
14255
12
原创 四阶素数幻方问题
用1到16构成一个四阶幻方,要求任意相邻两个方格中的数字之各均为素数? (原帖见:http://topic.csdn.net/u/20070830/18/1f1957c1-5e66-4c3b-8883-d7eef64c8da1.html)NowCan 网友的解法:直接递归搜，4阶很快的。以下这个程序就是这样的思路，结果未经过验证。 /* 将1-N^2这N^2个数添如N*N的方格中，每个
2007-10-01 17:02:00
2631
原创 VBA看数字电影
VBA看数字电影,据说是一位荷兰人的杰作Sub view()Shell "telnet towel.blinkenlights.nl", vbNormalFocusEnd Sub
2007-09-30 23:11:00
1211
原创 关于括号式子的计数
CSDNCSDN社区专题开发/技术/项目数据结构与算法超超版主的问题:如果有n对括号，组成一个式子，而且括号的最深嵌套层次为k 满足这个条件的式子一共有几种？ 如果n=3，k=2则有3种: (())() ()(()) (()()) 能否找到递推公式？ --------------------------------------------------------------
2007-09-30 22:02:00
1216
转载 一沙一世界(10亿光年)，科学的图文介绍
光年，光走一年的路程。光速！它是速度公认的极限，每秒299792458米，能在眨眼间绕地球七圈半。看见么，就这么快的光，让他跑吧，跑个一年，所度量出来的距离就是一光年了。现在各位把滑鼠移到萤幕的左下角，点“开始”－“程式集”－“附属应用程式”－“小算盘”，都来动手算算它，这一年是31536000秒，一秒跑299792458米，乘出来就9454254955488000米，约等于十万亿公里吧。你说什么
2007-09-29 20:02:00
1164
转载 业余兼职的全行业薪酬对照(发表者: swf11519 )
买房，买车，还贷款；购物，逛街，高消费。现代人，特别是年轻人，常常抵御不了物质消费的诱惑，但一份薪水有时用起来实在是捉襟见肘，职场中的“月光族”越来越多了。 当然，消极不是方法，聪明的职场人主动出击，谋求新的赚钱途径。于是，“兼职”脱颖而出，成了最受欢迎的业余赚钱方式。兼职不是件新鲜事，在海外也相当流行。欧盟最新公布的就业形势报告显示，目前欧盟范围内共有3000万人从事兼职工作，而且这一数字
2007-09-28 09:40:00
3006
原创 VBA实现任意n阶幻方的一种填法(n≥3)
参考http://blog.csdn.net/northwolves/archive/2007/09/23/1796696.aspx的思路,拟代码如下:Sub magicsquare(ByVal n As Long, ByRef matrix())Dim i As Long, j As Long, k As Long, p As Long, a(), b()ReDim matrix(1 To
2007-09-23 21:56:00
2074
原创 在VBA中获取“我的文档”的目录路径
方法1. 读取注册表:Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long)
2007-09-23 14:31:00
3179
原创 应用API函数在用户窗体中画圆
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As LongPrivate Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String)
2007-09-23 14:23:00
3244
原创 VBA增加sheet,重名时自动命名
VBA增加sheet,如何在出现重名时自动命名?如 Sheets.Add ActiveSheet.Name = "mysheet"如果已经存在名称为“mysheet”的sheet，如何使增加的sheet名称自动加上一个括号变成"mysheet(1)"呢？ 即类似在某文件夹内不断复制同一文件的效果,代码如下:Sub addsheets()Dim i As Long, sh As
2007-09-23 14:10:00
10322
1
原创 反选EXCEL数据区域已选定的单元格
Sub 反选()Application.DisplayAlerts = FalseApplication.ScreenUpdating = FalseDim raddress As String, taddress As Stringraddress = Selection.Addresstaddress = ActiveSheet.UsedRange.AddressWith Sheets.Add
2007-09-23 13:57:00
6467
转载 n阶幻方的填法(n≥3)
幻方，亦称纵横图。台湾称为魔术方阵。将自然数1，2，3，……n*n排列成一个n*n方阵，使得每行、每列以及两对角线上的各个数之和都相等，等于n/2*(n*n+1)，这样的方阵称为幻方。例如：把1，2，3，4，5，6，7，8，9填入3*3的格子，使得：每行、每列、两条对角线的和是15。 8 1
2007-09-23 11:16:00
13158
1
原创 用VBA来解决大数据量计算逆矩阵的问题
EXCEL2003中应用minverse求逆矩阵，该函数在excel中的确存在计算范围上的限制，可能最大的计算范围是52*52。下面给出一个VBA的解法Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Lo
2007-09-21 13:54:00
5116
1
原创 一元三次方程求解
Sub SolveCubicEquations(ByVal CubicEquation As String, Optional ByVal x As String = "x", Optional ByRef result As String)Dim a As Single, b As Single, c As Single, d As Single, temp As String, n As By
2007-09-11 23:29:00
8159
原创 回溯实现数组元素的排列组合
参考http://blog.csdn.net/northwolves/archive/2007/08/29/1764177.aspx中的代码,将字符串数组x取n个元素进行排列组合:Sub getall(ByRef x() As String, ByVal n As Byte, Optional types As Byte = 0)Dim m As Long, num As Long, i As
2007-08-29 17:57:00
2758
原创 回溯实现数字的排列组合
从1--m中选n个数字的排列组合的简单实现,速度还可以:Sub getall(ByVal m As Byte, ByVal n As Byte, Optional types As Byte = 0)types=0为排列 types=1 为组合Dim num As Long, i As Integer, k As Integer, a(), s() As StringReDim a(1 To
2007-08-29 17:41:00
3741
原创 最接近π值的5位分数的算法
题目:求一个分数，分子5位数（第1位不是0），分母也是5位数（第1位不是0），分子和分母这10个数正好由0到9这10个数字组成（不缺也不重复）。求最接近π值的那个分数解法1(穷举法)Sub getit()Const num As Long = 3628800 10!Dim tt As Single, i As Long, j As Long, k As Long, temp1 As
2007-08-29 10:24:00
2579
原创 列出一个工作簿中所有已使用的自定义函数
需要添加对VB项目的信任Sub UDFSOFACTIVEWORKBOOK()Dim sh As Worksheet, r As Range, dic As Object, i As Long, temp As String, vbcomp, s() As String, UDF As StringFor i = 1 To ActiveWorkbook.VBProject.VBComponent
2007-08-06 00:30:00
1429
转载 What's The Greatest Software Ever Written?(From informationweek.com)
Whats The Greatest Software Ever Written? Witness the definitive, irrefutable, immutable ranking of the most brilliant software programs ever hacked. By Charles Babcock InformationWeek k
2007-07-11 17:47:00
2727
原创 调用EXCEL 实现阿拉伯数字转中文
方法一:Private Sub Command1_Click()Dim xlapp As Object, n As Currency, temp As StringSet xlapp = CreateObject("Excel.Application")Randomizen = Int(Rnd * 10 ^ 15)temp = ntemp = temp & vbCrLf & xlapp.Eva
2007-06-30 16:40:00
1430
原创 How to remove all characters between two brackets?
How to remove all characters between two brackets? Such as "12345 (rtetnj) dsfd (fddsgd) dsf "----> "12345 dsfd dsf " Use regexp syntaxes ,its too simple . Function StringWithoutBracke
2007-06-25 02:52:00
751
原创 一亿亿以下的阿拉伯数字转中文的自定义函数
Function trans(number As String) As String Dim x As String, y As String x = Split(number, ".")(0) Const upcase = "○一二三四五六七八九 十百千万十百千万亿十百千万十百千万" 定义汉字 If Val(x) >= 10 ^ 16 Then MsgBox "数目太
2007-06-25 02:45:00
1563
转载 “How to tell Japs from the Chinese” in Life
<!--webbot bot="ImageMap" rectangle="(9,3) (580,71) ../../../index.htm"src="../../../images/blacktitle.jpg" alt="blacktitle.jpg (12329 bytes)" border="0" startspan -->Background for "Life Magazi
2007-06-04 13:52:00
1558
原创 比较简短的拼音首字母自定义函数
Function pinyin(ByVal r As Range) As StringConst hanzi = "啊芭擦搭蛾发噶哈击喀垃妈拿哦啪期然撒塌挖昔压匝ABCDEFGHJKLMNOPQRSTWXYZZ"Dim i As Long, j As Byte, temp As StringFor i = 1 To Len(r.Text)For j = 1 To 24If Asc(Mid(r.Te
2007-05-24 22:43:00
2775
原创 EXCEL 判断一个单元格中是否有图片
比如判断[D8]单元格里有无图片：Sub MACRO1()Dim SH As Shape, HASPIC As BooleanFor Each SH In ActiveSheet.ShapesIf Application.Intersect(Range(SH.TopLeftCell.Address, SH.BottomRightCell.Address), [D8]) Is Nothing T
2007-04-10 11:24:00
8097
原创 dir()递归 遍历子目录
dir()递归即可：Private Sub Command1_Click()Listfiles "d:/JAVA", List1End SubSub Listfiles(ByVal mydir As String, ByVal filelist As ListBox)Dim i As Long, dirlevel As Long, fname As String, dirlist() As Str
2007-04-10 11:19:00
5551
空空如也
空空如也
TA创建的收藏夹 TA关注的收藏夹
TA关注的人