VBA编程入门：Excel的强大功能与实用技巧-优快云博客

最近接触了一下VBA编程，才知道Excel还能编程，而且还如此强大，真的是惊呆了，话不多说，先了解一下VBA常用的语法吧。

1、基础语法

//高级for循环
Function deleteArrayByIndex(list) As String
    Dim item
    For Each item In list
        MsgBox item
    Next item
End Function

//获取当前sheet的名称和位置
sheetIndex = ActiveSheet.index
sheetName = ActiveSheet.Name

//获取最后一行
Dim sheetIndex As Integer
lastRow = Sheets(sheetName).UsedRange.Rows.Count

//删除多行
Rows("7:12").Delete
Range("A12:Q12").Clear
Range("A12:Q12").ClearContents

//插入一行
Sheets(sheetName).Rows(10).Insert

//为某单元格赋值
Range("B" & 1).Select
Selection.formula = "D"

//contains,包含
If InStr(str, "zhangsan") <> 0 Then
Else
End If

//for循环 + Replace
For i = 0 To UBound(arr)
   arr(i) = Replace(Trim(arr(i)), ",", "")
   arr(i) = Replace(valueArr(i), ";", "")
Next i

//Split
list = "1,2,3,4"
arr = VBA.Split(list, ",")

//获取某单元格公式
Range("A12").formula

//return
exit function(函数)
exit sub(事件过程)

//截取字符串
Mid(a, 2, 3)  '提取第二个字符开始之后的3个字符

//获取字符串的首字符
Left(month, 1) 

//获取其它sheet单元格数据（第6行第21列）
Sheet1.Cells(6, 21).value

//获取单元格背景色
Range("A1").Interior.ColorIndex

//设置单元格背景颜色
For Each item In Range(Range("A1"), Range("H10"))
   If item.value = 0 Then
       item.Interior.ColorIndex = 10
   ElseIf item.value = 1 Then
       item.Interior.ColorIndex = 11
   End If
Next

//赋值
Dim a As range
Set a = Sheets(sheetName).range("A1:C6")
a.Borders.LineStyle = 1//表格线宽度
a.Font.ColorIndex = 1//颜色
a.Font.Name = "Arial"//字体
a.HorizontalAlignment = xlCenter//居中

//计算方法耗时
Dim t As Single
t = Timer
Timer - t

//do循环
Sub ClassNamer()
    Dim MyClasses As New Collection    ' 建立一个集合对象（Collection）。
    Dim Num    ' 计数用变量，用来对对象的个数计数。
    Dim Msg As String    ' 提示信息用变量。
    Dim TheName, MyObject, NameList    ' 对象信息用变体。
    Do
        Dim Inst As New Class1    ' 建立 Class1 的新实例。
        Num = Num + 1    ' 把计数变量 Num 加一，然后要求输入新对象个体的名称。
        Msg = "Please enter a name for this object." & Chr(13) _
         & "Press Cancel to see names in collection."
        TheName = InputBox(Msg, "Name the Collection Items")
        Inst.InstanceName = TheName    ' 将名称送入对象实例。
        ' 若用户输入了名称，将它加入集合。
        If Inst.InstanceName <> "" Then
            ' 将命名的对象加入集合。
            MyClasses.Add item := Inst, key := CStr(Num)
        End If
        ' 清除当前的引用，为对下一个对象做准备。
        Set Inst = Nothing
    Loop Until TheName = ""
    For Each MyObject In MyClasses    ' 建立名称列表。
        NameList = NameList & MyObject.InstanceName & Chr(13)
    Next MyObject
    ' 将名称列表在消息框中显示出来。
    MsgBox NameList, , "Instance Names In MyClasses Collection"
 
    For Num = 1 To MyClasses.Count    ' 从集合中删除名字。
        MyClasses.Remove 1    ' 因为每删除一个对象后，集合
                ' 会自动重排顺序，故每次迭代时只需删除第一个
    Next        ' 对象即可。
End Sub

//debug输出
Debug.Print

//字符串长度
Len(str)

//switch
Select Case myVal
	Case 1
	Case 2
	Case 3
	Case Else
End Select

//获取当月最后一天
day(DateSerial(year(Date), month(Date) + 1, 0))

//代码换行
 _

//判断是否是数字
IsNumeric

//退出循环
Exit For

2、 excel vba快速填充公式（也就是往下拉）

//excel vba快速填充公式（也就是往下拉）
Sheet1.range("A1:K1").AutoFill Destination:=range("A1:K10"), Type:=xlFillDefault

//**********解决乱码问题***********
//（注意：使用[ADODB.Stream]，需要在[VBA代码界面 -> 工具 -> 引用]中添加[microsoft activex data object 2.5 library]以上版本）
Dim ts As ADODB.Stream        
Set ts = New ADODB.Stream        
ts.Type = adTypeText
ts.Charset = "UTF-8"

'改行code根据文件而定

ts.LineSeparator = adLF
ts.Open

'文件装载

ts.LoadFromFile (filePath)        
Do While Not (ts.EOS)
   '行读取：ReadText(adReadLine)

   '全文件读取：ReadText(adReadAll)   
   lineBuffer = ts.ReadText(adReadLine)
   …

Loop

3、自定义MsgBox

//自定义MsgBox
//空 ->默认一个确认按钮
//1 ->一个确认，一个取消
//2 ->表示三个按钮（中止、再试行、忽略）
/*msgBoxRet返回值含义如下：
1     OK    
2     Cancel    
3     Abort    
4     Retry    
5     Ignore    
6     Yes    
7     No    
*/

msgBoxRet = (MsgBox("I am the most beautiful", 2))

4、文件更改名字

//文件更改名字
Sub renameFile()
    Dim f1 As String
	Dim f2 As String
	
    On Error Resume Next
    f1 = "C:\Users\data\a.html"
    f2 = "C:\Users\data\b.html"
    Name f1 As f2 
End Sub

5、form窗口程序批量更改文本框

//form窗口程序批量更改文本框
Private Sub WideToNarrow()
    Dim item

    For Each item In UserForm1.Controls
        If TypeName(item) = "TextBox" Then
            item.Value = gf_WideToNarrow(item.Value)
        End If
    Next item
End Sub

6、全角改半角

//全角改半角
Public Function gf_WideToNarrow(ByVal strSrc As String) As String

    Dim strResult As String
    strResult = StrConv(strSrc, vbNarrow)
    
    strResult = Replace(strResult, "乗", "-")
    
    gf_WideToNarrow = strResult

End Function

VBA函数批量将将字符由全角转为半角，或由半角转为全角

往期精彩内容：