实用VBA代码

打开Excel表格

Function openExcel(name As String)
    Dim wb As Workbook
    Dim sheetFrom As Worksheet

    '判断文件是否存在
    If Dir(name) <> "" Then
        Debug.Print name + "文件存在"
    Else
        Debug.Print name + "不文件存在"
    End If

    '在vba中，对象的使用需要先初始化
    Set wb = Workbooks.Open(name) 'name是表格的完整路径
    'sheetName是sheet表名，打开指定的sheet表
    Set sheetFrom = wb.Worksheets("sheetName") 
End Function

使用如下方法可以获取当前Excel文件路径

path = ThisWorkbook.Path
'获取上一级目录
file = Left(ThisWorkbook.Path, InStrRev(ThisWorkbook.Path, "\") - 1) + "\" + "config.txt"

遍历所有sheet表

Dim sheet As Worksheet
Dim i,row As Integer

For i = 1 To Worksheets.Count
    Set sheet = Worksheets(i)  
    Debug.Print sheet.Name
Next i

获取表格的行数和列数

    '使用如下方法获取行数和列，有时可能会比实际数大一些，存在空行空列
    row = sheet.UsedRange.Rows.count '表中有多少行
    col = sheet.UsedRange.Columns.Count '表格中多少列

操作单元格range和Cells

' 通过range对象来操作
Debug.Print sheet.Range("A" & i).Value
'通过Cells对象来操作
Debug.Print sheet.Cells(i, i).Value
'设置单元格背景颜色
sheet.Cells(i, i).Interior.Color = RGB(100, 255, 255)
'表示一个区域
sheet.range(cells(1,1),cells(3,3)) 

常用语法for/if/while

Dim sheet As Worksheet
Dim i As Integer

'for循环用法
For i = 1 To Worksheets.Count
    Set sheet = Worksheets(i)
    Debug.Print sheet.Name
Next i

'while用法
i = 1
While i <= Worksheets.Count
    Set sheet = Worksheets(i)
    'if用法
    If sheet.Name <> "Sheet1" And sheet.Name = "Sheet2" Then
        'Cells用法
        Debug.Print sheet.Cells(i, i).Value
    End If
    i = i + 1

Wend

'do while用法
i = 1
Do While i <= Worksheets.Count
    Set sheet = Worksheets(i)
    If sheet.Name <> "Sheet1" And sheet.Name = "Sheet2" Then
        'range用法
        Debug.Print sheet.Range("A" & i).Value
    End If
    i = i + 1
Loop

字符串处理

Function StringTest()
Dim s As String

s = "Hello,world "

'求长度
Debug.Print Len(s)
'去掉两端空格
Debug.Print Len(Trim(s))
'替换s中子串a，用b替代
Debug.Print Replace(s, "world", "chadm")
'从左边取若干字符
Debug.Print Left(s, 5)
'从右边取若干字符
Debug.Print Right(s, 5)
'从中间取若干字符
Debug.Print Mid(s, 1, 5)
's1中查找字符串s2，返回位置
Debug.Print InStr(s, "ll")
'从a位置在s1中查找字符串s2，返回位置
Debug.Print InStr(6, s, "ld")

End Function

日期处理

'now：返回当前的时间，格式是：2018/8/11 0:22:56
'date：返回当前的日期，格式是：2018/8/11
'time：返回当前的时间，格式是：00：00：0
Debug.Print Date
Debug.Print now()
Debug.Print time

定义有返回值的方法

Function getSheetLine(ByRef target As Worksheet, start As Integer) As Integer
Dim count As Integer
count = start

While target.Range("A" & count).Value <> ""
    count = count + 1
Wend
getSheetLine = count

End Function

需要注意在调用getSheetLine方法的，定义target需要采取如下方式
Dim target As Worksheet
如果定义为
Dim sheet,target As Worksheet
会报byref类型不匹配

vab打开txt文件

Function improtProject()

Dim rLine As String
Dim i As Integer ' line number
Dim j As Integer
Dim k As Integer
Dim file As String
Dim arr
Dim dts As Worksheet

Set dts = ThisWorkbook.Worksheets("Config")

i = 1
k = 4
file = ThisWorkbook.Path + "\" + "config.txt"
Open file For Input As #1
' stay inside the loop until the end of file is reached
Do While Not EOF(1)
    Line Input #1, rLine
    'debug.Print rLine
    i = i + 1
    arr = Split(rLine, " ")
    Debug.Print arr(0), arr(1)
    dts.Range("A" & k).Value = arr(0)
    dts.Range("B" & k).Value = arr(1)
    k = k + 1

Loop

Close #1

End Function

vba里面调用excel函数

'第三行第i列的值等，prodts表格的L列里面所有小于等于第二行第i列的值
Cells(3, i) = WorksheetFunction.CountIf(prodts.Range("L:L"), "<=" & Cells(2, i))

发送email邮件

Sub Mail_workbook_Outlook_1()
'Working in Excel 2000-2016
'This example send the last saved version of the Activeworkbook
'For Tips see: http://www.rondebruin.nl/win/winmail/Outlook/tips.htm
    Dim OutApp As Object
    Dim OutMail As Object

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    On Error Resume Next
    With OutMail
        .To = "XXXXXX"
        .CC = ""
        .BCC = ""
        .subject = "This is the Subject line"
        .HTMLBody = "<H3><B>Dear Customer</B></H3>" & _
              "Please visit this website to download the new version.<br>" & _
              "Let me know if you have problems.<br>" & _
              "<A HREF=""http://www.rondebruin.nl/"">Ron's Excel Page</A>" & _
              "<br><br><B>Thank you</B>"
        .Attachments.Add ActiveWorkbook.FullName
        'You can add other files also like this
        '.Attachments.Add ("C:\test.txt")
        .Send   'or use .Display
    End With
    On Error GoTo 0

    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub