(1)单行写法(后面将省去首尾两句)
xxxxxxxxxxSubTest()If条件Then语句endsub使用函数:iif(条件,真,假)
xxxxxxxxxxIIf(myName="XX","OK","ERROR")'myName是变量(2)多行写法
xIf条件Then语句EndIf’if-elseIf条件Then语句1Else语句2EndIf2.多条件(1)if...elseif...elseif...endif
xxxxxxxxxxif条件1then语句1ElseIf条件2then语句2......Else所有条件都不成立时运行的语句EndIf(2)SelectCase...caseIs...EndSelect
xxxxxxxxxxSelectCaseRange("A8").value'或者Cells(i,"B")CaseIs<0sign="负数"CaseIs>0sign="正数"CaseElsesign="零"EndSelect
xxxxxxxxxxfor变量=初始值to终值step步长'如果省略step不写,默认步长为1语句next变量'可省略变量ForEach...Nextxxxxxxxxxxforeach变量in数组(指定的集合)语句[Exitfor]'终止循环'next变量DoWhile...Loopxxxxxxxxxx‘先判断,再决定是否执行dowhile条件语句loopDo...LoopWhilexxxxxxxxxx’先执行后,再判断。do语句loopuntil条件While...Wendxxxxxxxxxxwhile条件语句wendUnion(区域1,区域2,.....)联合区域xxxxxxxxxxforeach变量inUnion(Range('a1:a10'),Range('c4:c12'))代码next变量结束、终止程序1.终止程序(END)End语句可以单独使用,也可以结合部分控制关键字使用,如Function、If、Select、Sub、With等。End语句用于立即结束一个过程或者块,它提供了一种强制中止程序或结束语句块的方法。
xxxxxxxxxxsubtest()ifa=1ThenMsgBox"错误退出程序"End'结束运行过程EndIfEndSub2.退出、跳出(EXIT)Exit语句用于强制退出Do-Loop、For、Function函数、Sub过程或者Property等代码块,该语句只有结合其他关键字才可发挥作用。
(1)For循环的退出
xxxxxxxxxxForEachmyCellinRange("A1:H10")IfmyCell.Value=""ThenmyCell.Value="empty"ElseExitFor'退出循环EndIfNextmyCell如果是Forto结构的循环,同样使用ExitFor语句来退出。
(2)Do或DoWhile语句的退出
xxxxxxxxxxExitDo(3)退出Sub过程
xxxxxxxxxxExitSub(4)退出函数Fuction
xxxxxxxxxxExitFunction(5)结束本次或跳过
VBA中没有continue和break,循环的终止通过exitdo或exitfor实现。
如果仅仅跳出该次循环的话,建议用goto加行号跳转,或者ifelse判断的时候不写执行内容实现跳过循环。
重复代码部分的简写
xxxxxxxxxxWith......EndWith
GoToXXX标签
(1)XXXX参数可以是任意的行标签或行号。
(2)GoTo只能跳到它本身所在过程中的行,不能跳转到其它Sub过程中去。
xxxxxxxxxxSubmyTest()Dimaifa=1gotoline1elsegotoline2line1:'标签1代码1...line2:'标签2代码2...EndSub2.On...GoSub/On...GoToxxxxxxxxxxOnErrorGoToXX标签'如果错误产生,则跳转到某行/标签OnErrorResumeNext'如果错误产生,则继续下一条语句OnErrorGoTo0'清除当前设置的错误陷阱xxxxxxxxxxOnErrorGoToXX标签'如果遇到错误就跳转到标签......ExitSub/Function'如果没有这个退出过程语句,就会依次执行后面的所有语句XX标签:......获得错误码代号(数字):Err.number
xxxxxxxxxxSubmyTest()OnErrorResumeNext......IfErr.number=9thenMsgBox("ERROR")EndIfEndSub
xxxxxxxxxxDimdAsObjectSetd=CreateObject("Scripting.Dictionary")2.方法字典有6个成员方法:Add、Exists、Keys、Items、Remove、RemoveAll
(1)添加内容
xxxxxxxxxxd.Addkey,item'例:d.Add'优秀',80d(key)=item'例:dic('及格')=60'(2)d.Exists(key)
判断键是否存在于字典中;如果存在,返回True,否则返回False。
(3)d.Keys()
获取字典所有的键,返回类型是一维数组(数组下标从0开始)
字典使用foreachnext结构进行遍历时,返回的是key
ForEachdiInd也可以写成ForEachdiInd.keys
(4)d.Items()
获取字典所有的值,返回类型是一维数组。
(5)d.Remove(key)
从字典中移除一个条目,是通过键来指定的。如果指定的键不存在,会发生错误。
(6)d.RemoveAll
清空字典
字典有4个属性:Count、Key、Item、ConpareMode。
(1)Count
用于统计字典中键-值对的数量。也可以简单理解为统计字典中键的个数。
(2)Key
用于更改字典中已有的键。如果指定的键不存在,则会产生错误。
xxxxxxxxxxd.Key('apple')='Orange'(3)Item
用于写入或读取字典中指定键的值,如果指定的键不存在,则会新增。
xxxxxxxxxxDebug.Printd.Item('apple')'读取d.Item('apple')=10'写入d('apple')=10‘与上面写入一样(4)CompareMode
当用字符串做为key时是否区分大小写,如Dic.CompareMode=1不区分大小写,Dic.CompareMode=0区分大小写;默认是区分大小写的。
总结:通过key键访问字典元素item值
xxxxxxxxxxCells(1,1)=d('a')Cells(1,1)=d.Item('a')'与上者相同4.转置xxxxxxxxxxDimdAsObjectSetd=CreateObject("scripting.dictionary")'引用Range("A1").Resize(d.Count,1)=Application.Transpose(d.keys)'字典的键转成1列Range("A1").Resize(d.Count,1)=Application.Transpose(d.items)'字典的值转成1列Range("A1").Resize(1,d.Count)=dic.keys’字典的键成一行Range("A1").Resize(1,d.Count)=dic.items’字典的值成一行'键和值转成两列写入表格Range("A1").Resize(d.Count,2)=Application.Transpose(Array(d.keys,d.items))
1.直接定义数组有多少个元素。括号里的数值n为上标值,下标从0开始到上标n。
xxxxxxxxxxDimArr(2)AsVariant'定义一个下标为0,上标为2的一维数组,共计3个元素DimArr(2)’默认索引从0开始Arr(0)=1Arr(1)=2Arr(2)=3DimArr(1to10)'定义一个下标为1,上标为10的一维数组,共计10个元素Arr(1)="A"......Arr(10)="J"Dimarr(1To10,1To2)AsInteger'定义一个10*2的二维数组(10行,2列),其中个数不能使用变量。Dimarr(1,1)AsVariant'Dimarr(0To1,0To1)AsVariant'arr(0,0),arr(0,1),arr(1,0),arr(1,1)4个元素,默认索引从0开始2.用Array函数创建
xxxxxxxxxxDimarrAsVariantarr=Array("vba",100,3.14)'一维数组arr=Array(Array("张三",100),Array("李四",76),Array("王五",80))'二维数组3.调用Excel工作表内存数组
xxxxxxxxxxDimarr1,arr2arr1=[{"A","B",1,2}]'一维数组,用逗号分隔arr2=[{"a",10;"b",20;"c",30}]'二维数组,分号分隔,表示一行
如果定义为dinarr1()asvariant或dimarr1()缺省,都会默认为,可以存储变量的数组。
xxxxxxxxxxDimarr()ReDimarr(2)arr(0)=1arr(1)=2arr(2)=3’以下错误(必须定义元素个数后才可以给一个元素赋值)dimarr()arr(0)=1arr(1)=2
xxxxxxxxxxdimarr(2)'定义了3个元素的一维数组,下标默认从0开始Arr(0)=Range("A1")Arr(1)=Range("A2")Arr(2)=Range("A3")
将某一个区域中单元格的数值赋给数组,无论是读取一行、一列、多行多列,数组都是二维的。
xxxxxxxxxx'(1)从一列单元格中的数据写入数组,返回arr1(二维)arr1=Range("A1:A4")'将一列生成二维arr1(4,1),4行1列,下标默认从1开始'(2)从一行单元格中的数据写入数组,返回arr2(二维)arr2=Range("A1:D1")'将一行生成二维arr2(1,3),1行3列,并不是一维的,下标默认从1开始'(3)从多行多列单元格中的数据写入数组,返回arr3(二维)arr3=Range("A1:D4")'将多行多列生成二维arr3(4,4),4行4列,下标默认从1开始3、将数组写入单元格(1)写入一行,需要一维或者二维(1,n)
xxxxxxxxxx'一维arr1=[{1,2,3}]Range("A1:C1")=arr1'二维'方式1arr=Range("A1:C1")Range("A5:C5")=arr'方式2Dimarr(1,3)arr(0,0)=11arr(0,1)=12arr(0,2)=13Range("A1:C1")=arr(2)写入一列,需要二维
xxxxxxxxxxarr2=[{1;2;3}]Range("A1:A3")=arr2(3)写入多行多列,需要二维
xxxxxxxxxxarr3=[{1,2,3;"A","B","C"}]Range("A1:C2")=arr3(4)取一列写入一行,需要转置
xxxxxxxxxxarr4=Range("A1:A4")Range("A1:D1")=Application.Transpose(arr4)
(1)取出一行,结果是一维
xxxxxxxxxxarr=Range("A1:B5")'二维(5行,2列)Application.Index(arr,2,0)’取出第2行,结果数组是一维(2)取出一列,结果是二维
xxxxxxxxxxApplication.Index(arr,0,2)‘取出第2列,结果数组是二维(多行,1列)(3)将一列单元格的数值写入一行单元格,需要转置,也就是n行1列,转成1行n列。
xxxxxxxxxxDimarrarr=Range("A1:A8")'读取一列单元格数据,这也是二维Range("C1:H1")=Application.Transpose(arr)'写入一行Range("C1").Resize(1,8)=Application.Transpose(arr)’写入一行Range("D1").Resize(8,1)=arr'写入一列单元格
总结:
(1)一维数组下标默认为0;二维数组中下标默认为1;
(2)一维数组写入单元格时为一行,但一行单元格写入数组时为二维(1行,几列);
(3)将一行或者一列单元格数值写入数组,都是二维的。
xxxxxxxxxxDimaAsVariantDimbAsVariant'Joinusingspacesa=Array("Red","Blue","Yellow")b=Join(a,"-")'Red-Bule-YellowxxxxxxxxxxDimaAsVarianta=Split("Red$Blue$Yellow","$")'a=Array("red","blue","yellow")数组的筛选(Filter)xxxxxxxxxxarr=Array("ABC","F","D","CA","ER")arr1=VBA.Filter(arr,"A",True)'筛选所有含A的数值组成一个新数组arr2=VBA.Filter(arr,"A",False)'筛选所有不含A的数值组成一个新数组数组维度的转换(Transpose)xxxxxxxxxx'一维转二维arr=Array(10,"vba",2,"b",3)arr1=Application.Transpose(arr)'转换后的数组是1列多行的二维数组xxxxxxxxxx'二维数组转一维注意:在转置时只有1列N行的数组才能直接转置成一维数组arr2=Range("A1:B5")arr3=Application.Transpose(Application.Index(arr2,0,2))'取得arr2第2列数据并转置成1维数组判断元素是否在数组中数组只能用循环或者遍历了,如果是excel中的,还可以用worksheetfunction.match判断元素是否存在,可以考虑把数组转变成字典,字典对于这个问题处理起来就很轻松了。
xxxxxxxxxx'判断元素ifdic.exists("XX")=truethenmsgbox"XX存在"判断是一维还是二维没有直接的函数,一般用变通的方法,用错误获取。
xxxxxxxxxxSubA_num()OnErrorResumeNextDimaAsVariant,lnAsLong'一维数组a=Array(1,2,4,5)a=[{1,3,4;1,3,5}]'这是二维数组ln=UBound(a,2)IfErrThenMsgBox"一维数组"ElseMsgBox"二维数组"EndIfEndSub
注意:arr=Range("A1:C1"),是生成二维数组,1行3列,并不是一维的。
xxxxxxxxxxDimDataArr,arr1,arr2DataArr=Range("A1:D8")’8行4列的二维数组'取一行成一维,以第1行为例:arr1=Application.Index(DataArr,1,0)'取出第1行Range("A10,D10")=arr1'写入表格第10行'取一列成一维,以第4列为例:arr2=Application.Index(Application.Transpose(DataArr),4,0)'先转换行列,再取第4行,也就是原来的第4列arr2=Application.Transpose(Application.Index(arr,0,4))'先取出第4列,再转成一行Range("K1:K8")=arr2'将一维arr2写入表格K列xxxxxxxxxx
xxxxxxxxxxrow=UBound(arr,1)'有多少行数col=UBound(arr,2)'有多少列数与Index取行取列xxxxxxxxxxarr=Range("A1:D3")Range("A11:D11")=Application.Index(arr,3,0)'取出第3行写入单元格,是一行Range("A11:A13")=Application.Index(arr,0,2)'取出第2列写入单元格,是一列Range("A11:C11")=Application.Transpose(Application.Index(arr,0,2))'取出第2列,写入一行
1.遍历数组的每一个元素,并不是按行遍历;
例如:arr(2,3)遍历时会有2*3=6次,即每一个元素。
2.当二维数组为一列时,刚好每次遍历一行。
例:arr=range("A1:A10")
xxxxxxxxxxarr=range("A1:A10")foreachxinarrx‘正好是每行数据,因为只有一列。next
1.如果使用了Preserve关键字,就只能重定义数组最末维的大小,且根本不能改变维数的数目。
2.如果数组就是一维的,则可以重定义该维的大小,因为它是最末维,也是仅有的一维。
3.如果数组是二维或更多维时,则只有改变其最末维才能同时仍保留数组中的内容。
xxxxxxxxxxWorksheets(Sheet1).ActivateActiveSheet.Range("1:1").Select'选取第1行ActiveSheet.Range("B:B").Select'选取第B列Rows(5).Select'选取第5行Rows(1:5).Select'选取第1到5行dimy=10Rows("1:"&y).Select'选取第1到10行Columns(5).Select'选取第5列Columns(1:5).Select'选取第1到5列
xxxxxxxxxxWorksheets("工作表名称").Range("单元格范围").Find(要查找的值).EntireRow.SelectFind方法返回一个Range对象,也就是找到的那个单元格对象,然后再用这个对象的EntireRow来引用所在的整行。
注意,上述代码没有容错判断,如果在指定范围内没有“要查找的值”,代码会出错。
xxxxxxxxxxCells(i,1).EntireRow.Select'选中单元格所在行Cells(i,1).EntireColumn.Select'选中单元格所在列Rows(Range("A1").Row).Select'选中一行Column(Range("A1").Column).Select'选中一列
xxxxxxxxxxUsedRange.Rows.CountUsedRange.Columns.Count缺点:有时可能会比实际数大一些,原因是如果你把最后几行(列)数据清除后(非整行或整列删除),用这个命令仍返回未清除前的值。就是说现在虽然是空的,但是你曾经用过也算你的。
xxxxxxxxxxRange("A65535").End(xlUp).Row'最后一行Range("IV1").End(xlToLeft).Column'最后一列Cells(n,Columns.Count).End(xlToLeft).Column'求n行最后一列的列数可以简写为
xxxxxxxxxx[A65536].End(xlUp).Row[IV1].End(xlToLeft).Column缺点:只能计算出一列(行)的最后一个单元格所在的行(列)数。本例是只返回A列最后一个单元格所占的行数。
单元格End属性:xlToLeft,xlToRight,xlUp,xlDown
xxxxxxxxxxRange("A1048576").End(xlUp).offse(1,0).value="XXX"'改进当A1单元格为空值dimcAsRangesetc=Range("A1048576").End(xlUp)ifc.value<>""thenc.offse(1,0).value="XXX"elsec.value="XXX"endif
xxxxxxxxxxSubXXX()....EndSubxxxxxxxxxxFunctionMerge(xAsString,yAsString)AsString'函数包括函数名、参数列表、返回值类型Merge=x&y'函数带返回值EndFunctionxxxxxxxxxxFunctionzmj(x)zmj=(x/6.03)-x*0.03函数带有返回值EndFunction调用函数、过程1.VBA内置的函数xxxxxxxxxxVBA.SplitSplit2.工作表中的函数xxxxxxxxxxApplication.WorksheetFunction.CountIfWorksheetFunction.CountIf3.调用自定义的函数、过程第1种:call函数名()
第2种:直接函数名
(1)function是函数,sub是子程序,都可以传递参数;
(2)函数允许带一个返回值,过程没有返回值。
(3)若使用call调用,有参数时必须带括号;
若直接调用,参数可不带括号。
1)无参数时
xxxxxxxxxxSubtest()callfunc’不能callfunc()func’不能func()EndSub2)有参数时
xxxxxxxxxxSubtest()callfunc1(1,2,3)func1,2,3EndSub3)函数有返回值,sub没有。
方法:函数名称=返回的数据
xxxxxxxxxxfunctionsum(a,b)asintegersum=a+b'带返回值endfunction函数可以有返回值,过程sub不能;Sub只能执行一堆语句而没有返回值。
xxxxxxxxxxWorksheets.Add'在活动工作表前插入一张工作表Worksheets.Addbefore/after:=Worksheet(5)'在指定工作前、后插入Worksheets.AddCount:=3'插入3张工作表xxxxxxxxxxSheets.Addafter:=Sheets(Sheets.Count)Sheets(Sheets.Count).name="新表名称"可以简写为:Sheets.Add(after:=Sheets(Sheets.Count)).Name="新表名称"Sheets.Add.Name="XXXX"若存在则不建表;若不存在,则新建表并且在1个位置。
xxxxxxxxxxFunctionIsSheetResult(shtName)'''判断Result表是否在,不存在就新建OnErrorGoToAThisWorkbook.Sheets(shtName).ActivateExitFunctionA:ThisWorkbook.Sheets.Add(before:=Sheets(1)).Name=shtNameEndFunction2.删除xxxxxxxxxxApplication.DisplayAlerts=False'关闭提示Sheets("XXX").deleteApplication.DisplayAlerts=True'开启3.引用的3种方法xxxxxxxxxxWorksheets.Item(3)'引用第3张工作表Worksheets(3)'引用第3张工作表Worksheets("XXX工作表")‘引用XXX工作表Sheet3.Range("A1")'代码名称引用工作表,而不需要先写Worksheets4.获取名称方法一:
xxxxxxxxxxSubSheetsName()Fori=1ToSheets.CountCells(i,1)=Sheets(i).Name'表的名称NextEndSub方法二:
xxxxxxxxxxSubShtName()dimshtAsWorksheetforEachshtinWorksheetssht.name'工作表名称NextshtEndSub5.修改名称xxxxxxxxxxWorksheets(1).Name="XX工作表"6.激活工作表xxxxxxxxxxWorksheet(3).Activate'激活Worksheet(3).Select’激活,两者基本无差别Workbooks(3).ActiveSheet'选中激活的工作表7.复制和移动复制:copy,移动:move
xxxxxxxxxxWorksheets(1).Copybefore/after:=Worksheets(3)'将第1张工作表复制到第3张工作表之前/后Worksheets(1).Copy'复制到新工作薄中去8.隐藏和显示xxxxxxxxxxWorksheets(1).Visible=False'隐藏Worksheets(1).Visible=True’显示9.表的数量xxxxxxxxxxWorksheets.count'工作表的数量10.Sheets和Worksheets区别Sheets表示工作簿中所有类型的工作表的集合;
Worksheets表示仅有普通工作表的集合。
xxxxxxxxxxApplication.ScreenUpdating=False'关闭Application.ScreenUpdating=True'开启2.警告对话框xxxxxxxxxxApplication.DisplayAlerts=False'关闭Application.DisplayAlerts=True'开启
打开在对话框中选中的文件。如果成功打开文件,返回True;如果取消,返回False。
xxxxxxxxxxifApplication.FindFile=TruethenMsgBox"已打开文件"elseMsgBox"你已取消操作"Endif2.用GetOpenFilename方法获得在对话框中选中的文件名称(包含路径)。
xxxxxxxxxxApplication.GetOpenFilename(Filefilter:="Excel文件,*.xls;*.xlsx")'可简写为:Application.GetOpenFilename("Excel文件,*.xls;*.xlsx")当多种类型文件时,用分号隔开。
xxxxxxxxxxfilePath=Application.GetOpenFilename("Excel文件,*.xls;*.xlsx")IffilePath=Falsethenmsgbox("没有选中文件")elsefileName=mid(filePath,InStrRev(filePath,"\")+1)EndIf从全路径中提取文件名称
xxxxxxxxxx'例如filePath="C:\Users\Administrator\Desktop\学习笔记\VBA\MyTest.xlsx"fileName=mid(filePath,InStrRev(filePath,"\")+1)'MyTest.xlsx
要在VB中操作Excel,需要引用Excel对象模型。方法,在菜单里选择[工程]--[引用],在窗口里勾选MicrosoftExcelXX.XObjectLibrary其中,XX.X取决于你安装的Office的版本号。
Cells(行,列)
xxxxxxxxxxCells(1,2)'B2单元格Cells(1,"B")Range(Cells(1,1),Cells(10,4))'A1:D10单元格行号只能是数字,列可以是数字,也可以是字母("A"、"B"、"C"....)。
xxxxxxxxxxCells(1,3)="1,3"txt="1,3"arr=split(txt,",")Cells(arr(0),arr(1))'报错,因arr(1)获取到的是字符串类型Cells(arr(0),arr(1)*1)'没问题,已转成数字类型split提取出来的值是字符类型,注意转成数字。
(1)resize第一个参数表示扩张后的行数,方向是向下;(2)resize第二个参数表示扩张后的列数,方向是向右;(3)resize以该单元格为起点正整数,不支持0和负数。
xxxxxxxxxxRange("A1").Resize(1,4)'range("A1:A4")Cells(1,"A").Resize(1,4)'range("A1:A4")Cells(1,1).Resize(1,4)'range("A1:A4")Cells(1,1).Resize(10,4).Select'选中A1:D10单元格Range(Cells(1,1),Cells(1,1).End(xlDown).End(xlToRight)).Select'选择所有单元格offset(参考位置,行,列,高,宽)语法:OFFSET(reference,rows,cols,height,width)
offset函数是一个引用函数,表示引用某一个单元格或者区域。
在D3单元格输入公式=OFFSET(A1,2,2,1,1),其中A1是参考系,接着的2,2分别表示下,右移动的行数和列数,同样向上,左则是负数。最后面的1,1表示引用的区域大小是一行一列,也就是一个单元格。
总结:resize的行列数字只能是正数,不能有负数和0;
offset的行列数字可以正数、负数和0。
xxxxxxxxxxsheets("XXX").Cells.Clear'清空整个表格所有内容和属性range("A1:C8").ClearContents'只清除值range("A1:C8").ClearFormats'只清除样式
(1)数字转换为字母
数值范围:65~90大写字母;97~122小写字母。64是@符号
xxxxxxxxxxChr(65)'结果为A(2)字母转换为数字
xxxxxxxxxxAsc("A")'结果为652.字母大小写(1)小写转大写:UCase(string)
(2)大写转小写:LCase(string)
(1)工作表worksheet属性;
(2)当前工作表已经使用的单元格组成的矩形区域。
xxxxxxxxxx(1)单元格range属性;(2)单元格所在的周围以空行和空列隔开的区域。
xxxxxxxxxxsheets("XXX").UsedRange.select'前面是工作表Range("A1").CurrentRegion.select'前面是单元格
xxxxxxxxxxsheet1.range("A3","B8").copysheet2.range("A1").pastespecialxlvalues'只粘贴数值sheet1.range("A3","B8").copysheet2.range("A1")'简写OperationxlPasteSpecialOperation常量,指明粘贴时要进行的运算操作,即将复制的单元格中的数据与指定单元格区域中的值进行加减乘除运算。
SkipBlanks跳过空单元格
Transpose转置
xxxxxxxxxxRange('C2:C4').Copy'只粘贴格式而不粘贴值Range('E2').PasteSpecialPaste:=xlPasteFormats'只粘贴值Range('F2').PasteSpecialPaste:=xlPasteValues'粘贴值并保持列宽Range('C1').PasteSpecialPaste:=xlPasteColumnWidthsRange('C1').PasteSpecialPaste:=xlPasteValues'将行列转置Range('C1').PasteSpecialTranspose:=True'粘贴值并保持列宽Range('C1').PasteSpecialPaste:=xlPasteColumnWidthsRange('C1').PasteSpecialPaste:=xlPasteValuesRange('A1:A3').CopyRange('C1')'简写打印PrintOut/Debug.Printxxxxxxxxxx'打印机Sheets("XXX").printOutCopies:=份数'仅在立即窗口输出Debug.Print内容
xxxxxxxxxxExpression.Hyperlinks.Add(Anchor,Address,[SubAddress],[ScreenTip],_[TextToDisplay])Expression可以是超链接所在的WorkSheet,函数有两个参数是必须的,Anchor是超链接所在的详细区域位置,Address是超链接所要跳转的目标地址。ScreenTip:停留时提示文字;TextToDisplay:超链接的文字
1.跳转到某个网址
直接在Address中写上网址字符串即可。
(1)表格的位置是常量
一般情况下,不使用Address,而是将Address置为空,将目标表格地址放到SubAddress中。
xxxxxxxxxxThisWorkbook.Sheets("汇总").Hyperlinks.AddAnchor:=ThisWorkbook.Sheets("汇总").Cells(i,3),_Address:="",_SubAddress:="Sheet2!A1"注意SubAddress的值必须是"Sheet2!A1"才行。
(2)表格的位置是变量
xxxxxxxxxxThisWorkbook.Sheets("汇总").Hyperlinks.AddAnchor:=ThisWorkbook.Sheets("汇总").Cells(i,3),_Address:="",_SubAddress:="'"&Variant1&"'!C"&Variant2如果跳转的目标位置的Sheet是一个变量,那么将Sheet的名字写到Variant1中即可,如果目标表格的行号是一个变量,那么将行号写到Variant2即可。上图中的代码,点击汇总表的第i行第3列,将会跳转到名称为Variant1的Sheet的第Variant2行,第C列中。
MsgBox(Prompt[,Buttons][,Title][,Helpfile,Context])
2.Buttons,可选的参数,为数值表达式的值之和,指定显示的按钮的数目及形式、使用的图标样式、缺省按钮及消息框的强制回应等,可以此定制消息框。若省略该参数,则其缺省值为0。设置值见下表。3.Title,可选的参数,表示在消息框的标题栏中所显示的文本。若省略该参数,则将应用程序名放在标题栏中。4.Helpfile,可选的参数,为字符串表达式,提供帮助文件。若有Helpfile,则必须有Context。5.Context,可选的参数,为数值表达式,提供帮助主题。若有Context,则必须有Helpfile。
xxxxxxxxxxIfMsgBox("是否删除?",vbYesNo)=vbYesThenElseEndIf
xxxxxxxxxxRange("A1").value=100Range("A1:B10","A20:B30").value=100Range("A1:B10").Select'选中单元格'Cells(2,"D").value=100Cells(2,4).value=100[A1][A1:A10]Cells(行号,列标)
使用方括号[]时,里面不能使用变量。
所有的行和列
xxxxxxxxxxsheets("XXX").Rowssheets("XXX").Cells单元格的End属性:xlToLeft,xlToRight,xlUp,xlDown
(1)并集,在双引号内用逗号分隔
xxxxxxxxxxRange("A1:A4,B3:D5").select(2)交集,在字符串内用空格分隔
xxxxxxxxxxRange("A1:A4B3:D5").select(3)矩形区域,在双引号外用逗号分隔
xxxxxxxxxxRange("A1:A4","B3:D5").select3.混合引用xxxxxxxxxxRange("A1:E9").cells(2,3).Select'在A1:E9区域的,第2行与第3行交叉的单元格Range(Cells(1,1),Cells(10,5)).Select'选中A1:A10单元格’相当于下面两行Range("A1","E10").SelectRange("A1:E10").Select'索引号引用Range("B3:F9").cells(8)'在B3:F9区域中第8个单元格4.单元格属性(1)End属性:xlToLeft,xlToRight,xlUp,xlDown
xxxxxxxxxxRange("A1048576").End(xlUp).offset(1,0).value="XXX"(2)值Value、个数Count、地址Address
(3)Activate、Select
xxxxxxxxxxThisWorkbook.Name'名称ThisWorkbook.Path'路径ThisWorkbook.FullName'路径+名称2.创建工作簿1.创建空白工作簿
xxxxxxxxxxThisWorkbook.add'Excel默认空白工作簿2.将某个工作簿文件作为新建工作簿的模板
xxxxxxxxxxThisWorkbook.addTemplate:="D:\我的文件\模板.xlsm"ThisWorkbook.add"D:\我的文件\模板.xlsm"可以省略参数名称Template
(1)打开时,必须是全路径(路径+文件名)
xxxxxxxxxxWorkbooks.OpenFilename:="D:\XXX\ABC.xlsm"Workbooks.Open"D:\XXX\ABC.xlsm"’简写xxxxxxxxxxFilePath="D:\我的文件\模板.xlsm"Workbooks.Open(FilePath)(2)关闭
xxxxxxxxxxWorkbooks.Close'关闭当前打开的所有工作簿(仅仅关闭,但不能退出Excel文件)Workbooks("XXXX").Close'关闭名称为XXXX工作簿'Workbooks("XXXX").Closesavechange:=True'关闭并保存Workbooks("XXXX").CloseTrue'简写xxxxxxxxxx'从全路径中提取文件名称filePath="C:\Users\Administrator\Desktop\学习笔记\VBA\MyTest.xlsx"fileName=mid(filePath,InStrRev(filePath,"\")+1)'MyTest.xlsx
(3)关闭窗体和Excel文件
UserFrom的事件:Terminate、Querylose
xxxxxxxxxxApplication.DisplayAlerts=False'关闭提醒ThisWorkbook.Saved=False'不保存,True保存Application.Quit'退出Excel文件
xxxxxxxxxxThisWorkbook.Save'保存代码所在的工作簿'ThisWorkbook.SaveAsFileName:="D:\Test.xlsm"'另存文件后自动打开ThisWorkbook.SaveCopyAsFileName:="D:\Test.xlsm"'另存文件后不打开如果省略路径,默认保存在当前文件夹中。
xxxxxxxxxxWorkbooks("工作簿1").Activate'激活工作簿activeWorkbook.name'要选活动工作簿DimwkasWorkbooksetwk=Thisworkbook'当前工作薄6.最小化xxxxxxxxxxSub最小化工作簿()DimBOOKAsWorkbookB=InputBox("写入工作簿名称")SetBOOK=Workbooks(B)BOOK.ActivateActiveWindow.WindowState=xlMinimizedSetBOOK=NothingEndSub7.判断是否打开有没有不用遍历所有打开的工作簿就能知道工作簿是否打开呢?就好比在一群人中找到姓名为张三的小伙伴,是通过在一群人中一个一个去问,还是通过广播直接找张三呢。谁快谁慢,相必大家了然于胸,那VBA代码该如何去写呢?详细代码如下所示:
xxxxxxxxxxFunctionIsWbOpen2(strNameAsString)AsBooleanOnErrorResumeNextDimwkAsObject'如果工作簿没打开,直接赋值会报错,故使用OnErrorResumeNextSetwk=Workbooks(strName)IfErr.Number=0Then'或者Err.Number=9是未打开,报错IsWbOpen2=TrueElseIsWbOpen2=FalseEndIfEndFunction方法二(遍历)xxxxxxxxxxFunctionIsWbOpen1(strNameAsString)AsBoolean'如果目标工作簿已打开则返回TRUE,否则返回FALSEDimiAsLongFori=Workbooks.CountTo1Step-1IfWorkbooks(i).Name=strNameThenExitForEndIfNextIfi=0ThenIsWbOpen1=FalseElseIsWbOpen1=TrueEndIfEndFunction
Workbooks表示当前所有打开的工作薄的对象集合,与sheets用法一样。
workbooks带上路径就出错,下标越界,只写文件名就没有问题;
解决:取得最右边“\”的右边部分,也就是文件名称。
xxxxxxxxxxworkbooks(“f:\vba\aaa.xlsx”)'报错,下标越界workbooks("aaa.xlsx")'没有问题xxxxxxxxxxmyfile="f:\vba\aaa.xlsx"ifinstr(myfile,"\")>1thenmid(myfile,instrrev(myfile,"\")+1)'从全路径中提取出aaa.xlsxworkbooks(myfile)'不会下标越界
(1)IsEmpty()函数
空为True,否则为False
(2)其它方法
xxxxxxxxxxrange("A1")=""len(range("A1"))=0range("A1")=vbNullStringlen(trim(range("A1")))=0'防止有空格判断数据类型(1)isdate函数
判断一个数据是否为日期类型;是,返回true;不是,返回false
(2)isnumeric函数
xxxxxxxxxxa="123"Application.isnumber(a)'返回Falseisnumeric(a)'返回True
(3)并不是每一个数据类型都有对应的数据类型判断函数
stringt和boolean没有函数
(4)typename函数
返回数据的类型名称。
如typename(8),返回字符串“Integer”。注意返回的数据类型的字符串中首字母是大写的。
xxxxxxxxxxrange("A1").NumberFormatLocal="G/通用格式"range("A1").NumberFormatLocal="@"range("A1:A65536").NumberFormatLocal="@"
VBA中有许多内置函数,但要使用工作表中函数,Application对象的WorksheetFuntion属性。
例:统计A1:B10单元格中大于100的个数
xxxxxxxxxxApplication.WorksheetFuntion.CountIf("A1:B10",">100")2.常见内置函数
1.caption是显示在窗体中给用户看的;
2.(名称)是代码中识别要操作的窗口;
xxxxxxxxxxSubShowForm()loadInputForm'加载InputForm窗体'InputForm.show'显示InputForm窗体'unloadInputForm'关闭InputForm窗体'InputForm.hide'隐藏InputForm窗体'EndSub如果在调用窗体的Show方法前窗体没有加载,Excel会自动加载。
3.UserForm借助initialize事件初始化窗体
xxxxxxxxxxPrivatesubSub窗体_Initialize()性别.List=Array("男","女")'添加性别复合框选项EndSub
4.打开Excel就自动打开窗体
选择ThisWorkbook→Workbook~open事件
xxxxxxxxxxPrivatesubSubWorkbook_open()Application.Visible=False'隐藏Excel程序界面'denglu.showvbModal'显示denglu窗体,可省略vbModaldenglu.show'与前带参vbModal一样,模式窗体denglu.showvbModeless'无模式窗体EndSub模式窗体是指不能执行窗体之外的对象。
xxxxxxxxxxPrivateSubUserForm_QueryClose(CancelAsInteger,CloseModeAsInteger)IfCloseMode=vbFormControlMenuThenCancel=True'或者IfCloseMode=0ThenCancel=TrueEndSub
1.窗体内按钮的单击事件
xxxxxxxxxxPrivateSubBtn_Click()Application.DisplayAlerts=False'不显示自动提示和警告。你传的图片就是因为没这句所以Excel才提示。ThisWorkbook.Saved=True'保存工作簿(看需要)UnloadMe'关闭窗体Application.Quit'关闭ExcelEndSub2.用户窗体的Terminate事件中
xxxxxxxxxxPrivateSubUserForm_Terminate()ThisWorkbook.Saved=TrueApplication.QuitEndSub双击单元格事件1.选择“Worksheet”中的“BeforeDoubleClick”事件
2.利用If指定执行代码的单元格;
3.设置Cancel=True,利用Call执行宏。
xxxxxxxxxxPrivateSubWorksheet_BeforeDoubleClick(ByValTargetAsRange,CancelAsBoolean)IfTarget.Address="$A$1"ThenMsgBox"你好啊,你双击的单元格是"&Target.Address,48,"明白了吗?"EndIfEndSub获取窗体控件内容(值)xxxxxxxxxxAA窗体.showvbModeless'打开窗体,无模式窗体XXX控件名称.value'在窗体中可直接:XXX控件名称.valueAA窗体("XXX控件名称").value'在sheet表中使用时,窗体与Sheet同级,类似Sheets("Sheet1")列表框
xxxxxxxxxxWithListBox1.AddItem"XXX"'添加.RemoveItemi'删除索引为i的行.Clear'清空.ListIndex'当前选择的索引号(行号),从0开始.List(i)'当前索引行的值,多列为(行,列)例如:List(1,2)这是第1行第2列值.list=arr'数组对列表赋值,仅一列为一维,若多列为二维。.ColumnCount=6'设置为6列.ListCount'总行数.RowSoure="Sheet2!A1:D10"'指定数据源,字符串属性.ColumnHeads=True'设置标题.ColumnWidths="30;30;30"’设置列宽,单位为磅.TextAlign'文字位置,左,中,右EndWith参数详解
(3)ListBox1.Selected(i)=True
(4)ListBox1.MultiSelect=1
(6)ListBox1.Liststyle=0
(9)ListBox1.ControlSource="A6"
(10)ListBox1.BoundColumn=0
(11)ControlTipText=“把鼠标移动当前控件上的时候显示的提示文字”
举例
(1)列表框可多选时,反选的方法
xxxxxxxxxxPrivateSub反选_Click()IfListBox1.ListCount<1ThenMsgBox"请先获取数据表字段"ExitSubEndIfDimiAsIntegerFori=0ToListBox1.ListCount-1IfListBox1.Selected(i)=TrueThenListBox1.Selected(i)=FalseElseListBox1.Selected(i)=TrueEndIfNextEndSub(2)列表框可多选时,全选的方法
xxxxxxxxxxPrivateSub全选_Click()DimiAsIntegerIfListBox1.ListCount<1ThenMsgBox"请先获取数据表字段"ExitSubEndIfFori=0ToListBox1.ListCount-1ListBox1.Selected(i)=TrueNextEndSub(3)列表框可多选时,重置选择的方法
xxxxxxxxxxPrivateSub重置_Click()IfListBox1.ListCount<1ThenMsgBox"请先获取数据表字段"ExitSubEndIfDimiAsIntegerFori=0ToListBox1.ListCount-1ListBox1.Selected(i)=FalseNextEndSub(4)显示多列数据
xxxxxxxxxxSub列表框()Dimarr,EndRowEndRow=Sheets("XXX").[A65536].End(xlUP).Rowarr=Sheets("XXX").Range("A1:E"&EndRow)WithListBox1.ColumnCount=5'设置列表为5列.Lsit=arr'数据源,多列时为二维.TextAlign=fmTextAlignCenter'设置居中显示.ColumnWidths="48磅;48磅;48磅;48磅;48磅"'设置列宽,设置多列用分号;隔开.ColumnHeads=False'不显示表头.RowSoure="Sheet2!A1:D10"'指定数据源,字符串属性EndWithEndSub2.列表框添加数据三种方法(1)使用RowSource属性
这是一个字符串属性,而不是单元格区域
xxxxxxxxxx.RowSoure=range("Names").Address'Names指Excel命名区域(2)使用List属性或Column属性
List(行,列)Column(列,行)
xxxxxxxxxx.List=Range("Names").value(3)Additem方法
此方法在列表中添加一行,并且只能放置一个新值在第一列中;在多列时,需要使用List或Columnn属性放置新置。
xxxxxxxxxxWithListBox.Additem.List(0,0)="AAA".list(0,0)="BBB"EndWith
关键点:若要包含文件夹,则带上vbDirectory参数。
xxxxxxxxxxfile=Dir(path&"*.*",vbDirectory)DoWhilefile<>""......file=Dir'一定要写,不然死循环i=i+1Loop实例详细:
1.返回一个文件夹下一个文件的名字(包含后缀)
xxxxxxxxxxfilename=Dir("F:\userdata\Desktop\新建文件夹\")(1)dir后面的参数应该以反斜杠“\”结尾,这样才能返回该文件夹下的文件名称。否则“新建文件夹”会被当成一个文件名进行处理。
(2)Dir运行一次只能得到一个文件名。为得到下一个文件名,代码应该这样写:filename=Dir
(3)Dir后面不写任何参数,如果写了与前面相同的参数"F:\userdata\Desktop\新建文件夹",则会重新扫描该文件夹,又得到第一个文件名,如果更改为其他文件夹,就扫描该文件夹,得到它的第一个文件名。
(4)如果文件夹中有n个文件,或者说有n个符合条件的文件,那么当Dir运行第n+1次时,则返回一个空字符串,代表已经查找完所有的文件。Dir运行第n+2次时,程序将报错。
xxxxxxxxxxActiveSheet.Range("A21:E36").RemoveDuplicatesColumns:=5,Header:=xlYes其中Columns参数指定要删除重复项的列,如果是1的话,那么第一列中重复项所在行都会被删除,如果是2则只有1,2两列均重复的行才会被删除,以此类推,你的区域5列,那么只有5列均重复的行会被删除。
如果想在1,2列中只根据某几列的重复来删除,比如,135列。那么参数写为Columns:=Array(1,3,5)
案例:仅根据第1列重复项删除整行
xxxxxxxxxxOptionExplicitOptionCompareTextSub去重()DimsSheetAsWorksheetSetsSheet=ActiveSheetsSheet.Range("A1:A25").EntireRow.RemoveDuplicatesColumns:=1,Header:=xlYesEndSubxxxxxxxxxxOptionExplicitOptionCompareTextSub去重()DimsSheetAsWorksheetSetsSheet=ActiveSheetsSheet.Range("A1:H25").RemoveDuplicatesColumns:=1,Header:=xlYesEndSub总结:
1)去重时忽略大小写;
2)前或后带空格的项却不做为重复项,无法去重,见上面案例。-----关于这一点,经验验证:WPS2019---数据---删除重复项也是无法去除的,因此RemoveDuplicates方法和工具菜单的方式去重是一样的效果。