VBA代码

一个简单VBA-Demo

Sub VBA_Demo()
    Dim Total As Long, i As Long
    Total = 0
    For i = 1 To 100
        Total = Total + 1
    Next i
    MsgBox Total
End Sub

声明变量

Sub VariantDemo()
' 声明变量，默认为Variant
    MyVar = True
    MyVar = MyVar * 100
    MyVar = MyVar / 4
    MyVar = "Answer: " & MyVar
    MsgBox MyVar
End Sub

字符串合并

Sub VariantDemo2()
' 字符串的合并
    MyVar = "123"
    MyVar = MyVar + MyVar
    MyVar = "Answer: " & MyVar
    MsgBox MyVar
End Sub

确定数据类型

Sub VariantDemo3()
'TypeName 确定数据类型
    MyVar = True
    MsgBox TypeName(MyVar)      'boolean
    MyVar = MyVar * 100
    MsgBox TypeName(MyVar)      'integer
    MyVar = MyVar / 4
    MsgBox TypeName(MyVar)      'Double
    MyVar = "Answer: " & MyVar
    MsgBox TypeName(MyVar)      'string
    MsgBox MyVar
End Sub

声明局部变量

Sub MySub()
' Dim 声明局部变量
    Dim x As Integer
    Dim First As Long
    Dim InterestRate As Single
    Dim TodayDate As Date
    Dim UserName As String
    Dim MyString As String * 50     '声明为一个最大长度为50个字符的字符串
    Dim MyValue                 '默认为Variant数据类型
    Dim i As Integer, j As Integer, K As Integer   '一行代码对不同变量进行声明，不同于C语言
End Sub

数组

   如果只指定上界索引号，VBA将假定0是索引号
  如果让VBA假定1是所有只声明了上界索引号的数组的下界索引号，需要在模块的任意过程 之前 包含以下语句 option Base 1
   使用一组空括号声明动态数组
   RemDim 在使用动态数组之前，必须使用RemDim语句说明VBA数据中包含多少个元素。常常使用一个变量来指定数组中元素的个数，直到过程执行结束后才直到该变量的值
  RemDim Preserve可使用任意次数的RemDim语句，每当需要时就可以更改数组的大小。如果改变了数组的维数，那么将破坏现有的数值，若要保持数组中的现有值，可使用RemDim Preserve语句

	Dim MyArray(1 To 100) As Integer		' 声明包含100个整数的数据
	Dim MyArray(0 to 100) As Integer		' 声明包含101个整数的数据
	Dim MyArray(100) As Integer				' 默认0索引，声明101个整数的数据
' 声明多维数组
	Dim MyArray(1 To 10, 1 To 10) As Integer '声明10*10的二维数据
	MyArray(3,4) = 125 						 '二维数组的赋值
	Dim MyArray(1 To 10, 1 To 10, 1 To 10) As Integer '声明10*10*3三维数组
	MyArray(4,8,2) = 0 						 ' 三维数组的赋值
	Dim MyArray() As Integer				 ' 声明动态数组
	ReDim MyArray (1 to x)
	ReDim Preserve MyArray (1 to y)

处理对象和集合

With-End With 结构

  允许在单个对象上执行多项操作

Sub ChangeFont1()
' 更改选定的单元格属性
    Selection.Font.Name = "Cambria"
    Selection.Font.Bold = True
    Selection.Font.Italic = True
    Selection.Font.Size = 15
    Selection.Font.Underline = xlUnderlineStyleSingle
    Selection.Font.ThemeColor = xlThemeColorAccent1
End Sub

Sub ChangeFont2()
    With Selection.Font
        .Name = "Cambria"
        .Bold = True
        .Italic = True
        .Size = 12
        .Underline = xlUnderlineStyleSingle
        .ThemeColor = xlThemeColorAccent1
    End With
End Sub

For Each-Next 结构

   在集合的所有对象上执行某个动作，或要在集合的所有对象求值并在特定条件下采取动作

Sub CountSheets()
' 遍历当前活动工作簿的所有工作表
    Dim Item As Worksheet
    For Each Item In ActiveWorkbook.Worksheets
        MsgBox Item.Name
    Next Item
End Sub

Sub HiddenWindows()
' 遍历Windows集合中的所有对象，并计算隐藏窗口的总数
    Dim Cnt As Integer
    Dim Win As Window
    Cnt = 0
    For Each Win In Windows
        If Not Win.Visible Then Cnt = Cnt + 1
    Next Win
    MsgBox Cnt & " hidden Window."
End Sub

Sub CloseInactive()
' 关闭除活动工作簿之外的所有工作簿
    Dim Book As Workbook
    For Each Book In Workbooks
        If Book.Name <> ActiveWorkbook.Name Then Book.Close
    Next Book
End Sub

Sub MakeUpperCase()
' 将选中的单元格的内容转换为大写字母
    Dim Cell As Range
    For Each Cell In Selection
        Cell.Value = UCase(Cell.Value)
    Next Cell
End Sub

Sub SelectNegative()
' 选中活动工作表的第一行中的第一个负数
    Dim Cell As Range
    For Each Cell In Range("1:1")
        If Cell.Value < 0 Then
            Cell.Select
            Exit For
        End If
    Next Cell

GoTo语句

  该语句将程序的执行转移到一条新的指令，但必须要有标签标识此指令(带冒号的文本字符串或不带冒号的数据)，但GoTo语句不能转移到过程之外的指令

Sub GoToDemo()
    UserName = InputBox("Enter Your Name:")
    If UserName <> "Mikowoo" Then GoTo WrongName
    MsgBox ("Welcome Mikowoo...")
    Exit Sub
WrongName:
    MsgBox "Sorry, Only Mikowoo can run this macro."
End Sub

  如果姓名不是Mikowoo,那么过程将转移到执行带有WrongName标签的分支并结束;否则，该过程执行其他代码

If-Then语句

eg1

Sub GreetMel2()
    If Time < 0.5 Then
        MsgBox "Good Morning"
    Else
        If Time >= 0.5 And Time < 0.75 Then
            MsgBox "Good Afternoon"
        Else
            If Time >= 0.75 Then
                MsgBox "Good Evening"
            End If
        End If
    End If
End Sub

简化

Sub GreetMel()
    If Time < 0.5 Then
        MsgBox "Good Morning"
    ElseIf Time >= 0.5 And Time < 0.75 Then
        MsgBox "Good Afternoon"
    Else
        MsgBox "Good Evening"
    End If
End Sub

eg2

Select Case结构

  在三个或多个选项之间做出选择时，此结构更有用处
eg1

Sub GreetMe()
    Dim Msg As String
    Select Case Time
        Case Is < 0.5
            Msg = "Good Morning"
        Case 0.5 To 0.75
            Msg = "Good Afternoon"
        Case Else
            Msg = "Good Evening"
    End Select
    MsgBox Msg
End Sub

eg2: 假设Quantity的数值总是为整数

Sub Discount3()
    Dim Quantity As Variant
    Dim Discount As Double
    Quantity = InputBox("Enter Quantity: ")
    Select Case Quantity
        Case ""
            Exit Sub
        Case 0 To 24
            Discount = 0.1
        Case 25 To 49
            Discount = 0.15
        Case 50 To 74
            Discount = 0.2
        Case Is >= 75
            Discount = 0.25
    End Select
    MsgBox "Discount: " & Discount    
End Sub

另一种格式

Sub Discount4()
    Dim Quantity As Variant
    Dim Discount As Double
    Quantity = InputBox("Enter Quantity: ")
    Select Case Quantity
        Case "": Exit Sub
        Case 0 To 24: Discount = 0.1
        Case 25 To 49: Discount = 0.15
        Case 50 To 74: Discount = 0.2
        Case Is >= 75: Discount = 0.25
    End Select
    MsgBox "Discount: " & Discount
End Sub

eg3

Sub GreetUser1()
    Select Case Weekday(Now)
        Case 1, 7
            MsgBox "This is the weekend"
        Case Else
            MsgBox "This is not the weekend"
    End Select
End Sub

Sub GreetUser2()
    Select Case Weekday(Now)
        Case 2, 3, 4, 5, 6
            MsgBox "This is not the weeekend"
        Case Else
            MsgBox "This is the weekend"
    End Select
End Sub

Sub GreetUser3()
    Select Case Weekday(Now)
        Case 2 To 6
            MsgBox "this is not the weekend"
        Case Else
            MsgBox "This is the weekend"
    End Select
End Sub

eg4 当条件为True时，执行语句

Sub GreetUser4()
    Select Case True
        Case Weekday(Now) = 1
            MsgBox "This is the weekend"
        Case Weekday(Now) = 7
            MsgBox "This is the weekend"
        Case Else
            MsgBox "This is not the weekend"
    End Select
End Sub

Sub GreetUser5()
    Select Case True
        Case Weekday(Now) = 1 Or Weekday(Now) = 7
            MsgBox "This is the weekend"
        Case Else
            MsgBox "This is not the weekend"
    End Select
End Sub

在立即窗口中的输出

Sub ChangeCase()
    Dim MyString As String
    MyString = "This is a test"
    MyString = UCase(MyString)
    Debug.Print MyString
End Sub

判断单元格是否为空

Sub test()
    If ThisWorkbook.Sheets(3).Range("D2").Value = "" Then
        MsgBox "此单元格为空"
    Else
        MsgBox "不能这么使用"
    End If
End Sub