张亦Excel VBA——基础篇

'张亦Excel VBA——基础篇'写给每一个想学VBA但又无从下手的人'由于工作原因，笔者自学了VBA，以下便是学习过程中写的测试样例并做了注释，个人觉得对于有开发基础的朋友来说下面的样例很好理解，如果没有开发基础可能会多用一些时间来学习，其实VBA并不难，关键是要自己动手写。'本文并无商业目的，仅供大家参考，如果发现有错误或者想一起沟通交流VBA可以访问我的微博：【http://www.weibo.com/zychere】Option Explicit '强制声明变量Public str0 As String '声明公共变量'给变量赋值Public Sub mysub() '注意：如果声明成private则只能在模块内部调用    Dim str1 As String '此处定义变量还可以用以下方式：1、Dim str1 As String * 2                                                     '2、Dim str1$                                                     '3、Dim str1 As String,str2 as Integer    str1 = "test" '这里前面省略了"Let"    Const str2 As Single = 3.14 'str2是常量，值不能修改    MsgBox str2End Sub'一维数组Public Sub mysub2()    Dim array1(1 To 50) As String '声明数组，也可以写成Dim array1(50) As String    array1(1) = "a" '给数组赋值        Dim i As Integer    For i = 1 To 10 '循环给数组赋值    array1(i) = i    MsgBox array1(i)    NextEnd Sub'二维数组Public Sub mysub3()    Dim array1(1 To 10, 1 To 20) As String '定义二维数组也可以写成Dim array1(10,20)    array1(1, 3) = "二维数组测试"    MsgBox array1(1, 3)End Sub'动态数组、Array函数创建数组、Range对象创建数组、UBound/LBound、Join、TransposePublic Sub mysub4()    Dim array1() As String    Dim n As Long    n = Application.WorksheetFunction.CountA(range("A:A")) '统计有多少个非空单元格，常用Application方法    ReDim array1(n) As String    '-----------------------------------------------------------------------------    Dim array2() As Variant '不加As Variant和前面这句话效果是一样的    array2 = Array(1, 2, 3, 4, 5)    'MsgBox array2(0)    '-----------------------------------------------------------------------------    Dim array3() As Variant 'A1:C3必须有值    array3 = range("A1:C3").Value '注意：用这种方式赋值时，数组是二维数组，即使是这样array3 = Range("A1:A1").Value    range("E1:G3").Value = array3 '注意：利用这种方式给单元格赋值，array3的属性必须是Vaiant    '-----------------------------------------------------------------------------    MsgBox UBound(array3) & "_" & LBound(array3)    '-----------------------------------------------------------------------------    Dim txt As String    txt = Join(array2, "_")    'MsgBox txt    '-----------------------------------------------------------------------------    '将数组中的值批量写入不同的单元格，常用Application方法    range("H1:H9").Value = Application.WorksheetFunction.Transpose(array2)End Sub'比较运算符Public Sub mysub5()    'MsgBox Range("A1") Like "a*"    MsgBox Worksheets("Sheet1").range("A1") Is Worksheets("Sheet1").range("A1") '?这里不是很明白End Sub'内置函数Public Sub mysub6()    MsgBox "现在时间是：" & Time()End Sub'if...else...thenPublic Sub mysub7()    Dim array1() As Variant    Dim i As Integer    array1 = Array(1, 2, 3, 4, 5) '利用Array函数创建数组，前面提到过        For i = 0 To 4        If array1(i) > 3 And array1(i) < 5 Then            MsgBox "4"        Else            MsgBox "<>4" '这里把and替换成&也可以        End If    Next        End Sub'稍微复杂一点的if...else...并和for循环结合Public Sub mysub8()    Dim num As Integer    Dim array1 As Variant    Dim i As Integer    array1 = Array(1, 2, 3, 4, 5)    For i = 0 To 4 '开始for循环,注意这里最后还可以加一个[step 步长值]        num = array1(i)        If num > 0 Then '开始外层if判断（是否大于0）            MsgBox "the number is positive number"            If num = 5 Then '开始内层if判断（具体的数字）                MsgBox "num=5"            ElseIf num = 4 Then                MsgBox "num=4"            ElseIf num = 3 Then                MsgBox "num=3"            ElseIf num = 2 Then                MsgBox "num=2"            ElseIf num = 1 Then                MsgBox "num=1"            End If        Else            MsgBox "the number is nagtive number"        End If    NextEnd Sub'select case语句，这里就是类似java中的switch语句Public Sub mysub9()    Dim num As Integer    num = 5    Select Case num        Case Is > 0            MsgBox "the number is positive number"        Case Is < 0            MsgBox "the number is nagtive number"    End SelectEnd Sub'do...while语句(循环条件为true，则运行Loop之前的代码)Public Sub mysub10()    Dim i As Integer    i = 1    Do While i < 5        MsgBox i        i = i + 1    LoopEnd Sub'do...until语句(循环条件为false，则运行Loop之前的代码)Public Sub mysub11()    Dim i As Integer    i = 1    Do Until i > 5        MsgBox i        i = i + 1    LoopEnd Sub'for each...next(循环次数未知的情况下使用)Public Sub mysub12()    Dim sheet1 As Worksheet    Dim cell1 As range '注意：cell其实是range对象    Dim i As Integer '用来循环单元格    Set sheet1 = Worksheets("Sheet1") '注意：给对象变量赋值使用SET，SET 不能省略。    i = 1    For Each cell1 In sheet1.range("A1:A" & sheet1.Application.WorksheetFunction.CountA(range("A:A"))) '这里的意思是从A1找到本列最后一个非空单元格，常用Application方法        Set cell1 = sheet1.Cells(i, "A")        MsgBox cell1        i = i + 1    NextEnd Sub'with语句Public Sub mysub13()    Worksheets("Sheet1").Cells(1, "A") = "with测试123"    With Worksheets("Sheet1").Cells(1, "A").Font    .Name = "黑体"    .Bold = True    .ColorIndex = 5    End WithEnd Sub'参数测试_定义Public Sub mysub14(ran As range)    ran = 100    'MsgBox i & " test"End Sub'参数测试2_实现Public Sub mysub15()    Dim r As range    Set r = range("A1:A3")    Call mysub14(r)  '注意：如果调用有参数的过程必须加call关键词，如果不加则必须去掉后面的括号！    'MsgBox TypeName(r)End Sub'删除非活动的worksheetPublic Sub mysub16()    Dim sheet As Worksheet    Application.DisplayAlerts = False '常用Application方法：屏蔽显示警告提醒    For Each sheet In Worksheets        If sheet.Name <> ActiveSheet.Name Then            sheet.Delete        End If    NextEnd Sub'对文件的操作Public Sub mysub17()    Dim str As String    str = ThisWorkbook.FullName & "-----" & ThisWorkbook.Path    MsgBox str    '下面是文档激活的操作    Workbooks("aaa.xlsx").Activate '激活aaa.xlax    MsgBox ActiveWorkbook.Name '& "_____________" & ThisWorkbook.Name    Workbooks("test.xlsx").Activate '激活test.xlsx    MsgBox ActiveWorkbook.Name    '下面是打开关闭的操作    MsgBox Dir("D:\test.xlsx") '判断文件是否存在，一般同时用Len()函数确定文件名长度    Workbooks.Add ("D:\test.xlsx") '新建excel文档，如果不加参数就是新建一个空文档    Workbooks.Open ("D:\test.xlsx") '打开一个excel文档    ThisWorkbook.Save '保存当前文档，类似的方法还有saveas+路径    this.workboos.Close '关闭当前文档    Worksheets.Add '创建新的sheet，和workbook同理，可以添加before或者after标签    Worksheets("Sheet1").Name = "测试修改名称"    End Sub'文档复制操作，这个经常用所以单列出来Public Sub mysub18()    Worksheets("测试修改名称").Copy before:=Worksheets("测试修改名称")End Sub'range之——关于Offset和ResizePublic Sub mysub19()    Cells(1, 1).Offset(2, 5) = "offset test" '为下2右5单元格复制    range("A2").Resize(1, 4).Select '重新选择range范围End Sub'range之——UsedRangePublic Sub mysub20()    Dim sht As Worksheet    Set sht = Application.Workbooks("aaa.xlsx").Worksheets("test")    sht.UsedRange.Select '选择sheet中所有已用单元格    range("D2").End(xlDown).Select '选择D列最后一个已用单元格    MsgBox sht.range("D1").End(xlDown).Row '得到range范围列的已用行数    range("A1").Clear '清除End Sub'range之——cutPublic Sub mysub21()    range("A1:B2").Cut Destination:=range("D3:E4") ' 指定复制粘贴位置End Sub'遍历文件夹中的所有excel文件Public Sub mysub22()    Dim filename As String    filename = Dir("D:\*.xlsx")    Do While filename <> ""        MsgBox filename        filename = Dir    LoopEnd Sub'下面开始是函数function相关，其实和sub是类似的，只是多了返回值'第一个function,显示当前时间Public Function myfun1()    myfun1 = Time() '这里其实就是函数的返回值End Function'统计单元格中红色个数的函数Public Function myfun2(user_range As range) '这里的参数是用户选择    Application.Volatile True '注意：标记函数为易失性函数，常用Application方法    Dim range As range    For Each range In user_range        If range.Interior.ColorIndex = 3 Then        myfun2 = myfun2 + 1        End If    Next rangeEnd Function