博文
一些VBA的笔记(2009-02-26 10:31:00)
摘要：非常流行的排序函数：
sub BubbleSort(List() As String)
Dim First As Integer,Last As Integer
Dim i As Integer, j As Integer
Dim Temp
First=LBound(List)
Last=UBound(List)
For i=First To Last-1
For j=i+1 to Last
If UCase(List(i)>UCase(List(j)) Then
Temp=List(j)
List(j)=List(i)
List(i)=Temp
End If
Next j
Next i
End Sub
搜索字符串的函数是：InStr(Text, subStr)
访问Range里面的各个cell：
Rgn As Range
Dim mycell As Range
For Each mycell In Rgn
。。。。。。。
Next mycell
返回链接的地址：GetAddress(Hyperlink)
Function GetAddress(HyperlinkCell As Range)
GetAddress=Replace(HyperlinkCell .Hyperlinks(1).Address,"mailto:","")
End Function
静态随机函数：StaticRAND() 仅当用户强制刷新单元格才重新计算
循环体：
For i=1 to FinalRow Step 10 ...Exit For ...Next i
Do [While/Until]...Loop[While/Until]
对象变量及其历遍：
Dim WSD As Worksheet
Dim Mycell......
清除EXCEL文件单元格中的“零”(2007-11-26 11:38:00)
摘要：打开EXCEL的vba编辑器，插入一个模块，输入以下VB脚本
Public Sub Zero_Clean()
i = 1
While i < 1000 ' 1000行
For j = 1 To 50 ' 50列
If Cells(i, j) = 0 Then Cells(i, j) = ""
Next j
i = i + 1
Wend
End Sub
运行它，可以让1000行×50列范围内所有显示0的单元格变成空白格。......
用EXCEL结合ACCESS数据库组建通讯录（完整代码）(2007-04-09 12:57:00)
摘要：
自己编制的，共享一下：
模块1：（代码）
Dim btop
Dim bleft
Public Function GetDatabaseName()
GetDatabaseName = "DBQ=D:\INETPUB\WWWROOT\jshb\test.mdb;DefaultDir=;DRIVER={Microsoft Access Driver (*.mdb)};"
End Function
Public Sub InitPage()
btop = 4
bleft = 2
End Sub
Public Sub TitleName()
Cells(btop, bleft) = "id"
Cells(btop, bleft + 1) = "type"
Cells(btop, bleft + 2) = "姓名"
Cells(btop, bleft + 3) = "公司"
Cells(btop, bleft + 4) = "座机"
Cells(btop, bleft + 5) = "手机"
Cells(btop, bleft + 6) = "传真"
Cells(btop, bleft + 7) = "职位"
Cells(btop, bleft + 8) = "Email"
End Sub
Public Sub ClearPage()
Dim addr
b = btop + 1
addr = "A" & b & ":Z1000"
Range(addr).ClearContents
End Sub
Public Sub Serchmdb(ByVal SelectType, ItemContent, ItemName, st As String)
Dim cmd As String
Dim oAss As Object
Dim b
......
在EXCEL中操作ACCESS数据库(2007-03-31 17:29:00)
摘要：为了便于管理手中的一大堆联系厂家的联系方式，我建立了一个ACCESS的数据库文件（TEST.MDB（表名：telephone）），把所有的客户信息存在数据库里面。但是由于操作ACCESS数据库很不方便，我平时又习惯使用EXCEL，所以便想做一个EXCEL文件，能够与这个数据库文件连接起来，实现对数据的搜索、添加功能。于是使用VBA。
当然首先是建立一个空白的EXCEL，并在里面针对数据库的各个字段标题建立标题。如：
姓名
公司
座机
手机
传真
打开VBA编辑器，添加三个模块：
模块1：（从数据库取得全部数据，并显示到EXCEL文件中）
Public Sub Getmdb()
Dim cmd As String
Dim oAss As Object
connstr = "DBQ=D:\test.mdb;DefaultDir=;DRIVER={Microsoft Access Driver (*.mdb)};"
Set oAss = CreateObject("ADODB.connection")
oAss.Open connstr
cmd = "SELECT * FROM telephone ORDER BY id DESC"
Set rs = oAss.Execute(cmd)
btop = 4
bleft = 2
ast = "A" & btop & ":Z1000"
Range(ast).ClearContents
Do While Not rs.EOF
btop = btop + 1
Cells(btop, bleft + 2) = rs("姓名")
Cells(btop, bleft + 3) = rs("公司")
Cells(btop, bleft + 4) = rs("座机")
Cells(btop, bleft + 5) = ......
EXCEL中“名称”的使用一例(2006-07-10 21:58:00)
摘要：在EXCEL中，某些程序处理除了可以放在单元格中和VBA编辑器中，“名称”里面也可以放些编程的语句，下面就是一个小例子。
在单元格D8中输入“(2141.109-1333.7)+0.155*3+0.64”，选中D9单元格，点击菜单“插入”——“名称”——“定义”，在弹出窗体中上栏输入“结果”，下栏输入以下语句：
=IF(sheet1!D8<>0,EVALUATE(sheet1!D8),0)
然后在D9单元格中输入“＝结果”，就可以看到计算结果了。......
用Excel的VBA中显示非模态的窗体(2006-07-05 13:55:00)
摘要：UserForm1.Show vbModeLess
或者
UserForm1.Show 0......
在字符串中插入制表符和换行符(2006-07-05 13:48:00)
摘要：制表符vbTab
换行符vbCrLf
str1=str1 & vbTab
str1=str1 & vbCrLf
MsgBox str1......
在VBA中使用API(2006-07-05 13:44:00)
摘要：确定当前视频模式
Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
Pubilic Const SM_CXSCREEN=0
Pubilic Const SM_CYSCREEN=1
sub abc()
vidwidth=GetSystemMetrics(SM_CXSCREEN)
vidHeight=GetSystemMetrics(SM_CYSCREEN)
end sub
给程序添加声音（WAV）
Private Declare Function PlaySound Lib "winmm.dll" Alias "PlaySoundA" (ByVal lpszName As String, ByVal hModule As Long, ByVal dwFlags As Long) As Long
Consr SND_SYNC=&h0 '同执行播放命令
Consr SND_ASYNC=&h1 '异步执行播放命令
Consr SND_FILENAME=&h20000
Sub PlayWav()
WavFile="abc.wav"
Call PlaySound(WavFile,0&,SND_ASYNC Or SND_FILENAME)
end Sub
播放MIDI
private Declare Function mciExecute Lib "winmm.dll" (Byval lpstrCommand As string) As Long
mciExcute("Play" & MIDIFILE) '播放
mciExcute("Stop" & MIDIFILE) '停止播放......
一些VBA的小命令(2006-07-04 13:58:00)
摘要：关闭屏幕的更新动作：
application.ScreenUpdate=False
解决大小写比较的问题（A=a）,将下面语句添加到顶部：
Option Compare Text
防止出现错误消息框，在顶部添加：
application.EnableCanelKey=xlDisabled
强制函数不断重新计算
application.Volatitle True
自定义函数中接受可选参数
function ABC( Optional Ref1 As Variant)
判断是否传入了可选参数
if ismissing(Ref1) then
返回VBA数组的函数:
function ABC()
ABC=ARRAY（1，2，3，4...）
将水平方向的数组转置为垂直方向
application.transpose(Abc)
设置ARRAY的下界(默认值为0)
option Base
接受不定数量的参数的函数,使用数组作为最后一个参数，且...
function abc(patramArray list)
找到大小可以变化单元格子的边界
Range("A1").CurrentRegion.Copy Sheet(2).Range("A1")
Range(ActiveCell, ActiveCell.End(xlDown)).Select 'xlUp,xlToLeft,xlToRight
从某个过程执行函数(函数以及参数可以是字符串数字或者变量)
tt=application.run("finc_1","abc")
计算选中单元的数目
Selection.Count
Selection.Columns.Count
Selection.Rows.Count
一些有用的函数
FileExists
FileNameOnly ' 从带路径的文件名中抽出文件名
PathExists
RangeNameExists
SheetExists
WorkbooklsOpen
通过单元格内容选择内容：
Public Function SelectCell(nindex As Integer)
SelectCell = Cells(nindex, 1)......