VBA

1.字母列与数字列之间的转换

Sub test()
    With ActiveWorkbook
        a = sheets("Template").Range("L7:L1000").Value
        c = Range(Sheet1.Cells(1, 1), Sheet1.Cells(100, 100)).Value
        sheets("Template Summary").Range("Y8:Y1000") = a
        ‘b = sheets("Template Summary").Range("Y8:Y1000").Value + sheets("Template Summary").Range("Z8:Z1000").Value
        ‘将字母转为列数，将列数转为字母
        x = sheets("Template Summary").Range("Y8").Column
        y = Replace(Cells(1, x).address(False, False), "1", "")
    End With
End Sub

2.选择文件夹,遍历文件

With Application.FileDialog(msoFileDialogFolderPicker) ‘允许用户选择一个文件夹
        If .Show Then
            folderpath = .SelectedItems(1)
        Else
            MsgBox "没有选择文件，程序自动退出", vbOKOnly, "OTC"  ‘OTC设置的是自动关闭窗口
            Exit Sub
        End If
		‘遍历文件夹中的文件
		For Each fs In CreateObject("scripting.FileSystemObject").GetFolder(folderpath & "\").Files
            If fs.name Like "*OPMS_FIN_Journal_by_Cashier_and_Transaction_Code_GCR*" Then
			end if
		next
End With

3.自定义函数判断文件是否存在

‘判断文件是否存在
Function TestFileExistence(filePath)
    If Dir(filePath) <> "" Then
        TestFileExistence = 1
    Else
        TestFileExistence = 0
    End If
End Function

4.find与findNext函数的使用

Dim Obj as Object,Obj_Address as String
Obj = ActiveWorkbook.Sheets("CASHIER").range("A1:AZ20").Find("CASHIER_ID", LookIn:=xlValues, lookat:=xlWhole)
Obj_Address=Obj.Address

5.Application的属性设置

‘设置屏幕不更新，屏蔽警示框，屏蔽询问更新
    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
        .AskToUpdateLinks = False
    End With

6.Excel打开XML文件

Private Function import_CASHIER(filePath As String, work_name As String)
    Dim strTargetFile As String
    Dim wb As Workbook

    ‘提取evoucher.xml文件中的数据到此工作簿的evoucher表Opera E Voucher Status Report
     Application.ScreenUpdating = False
     Application.DisplayAlerts = False
     strTargetFile = filePath
     Set wb = Workbooks.OpenXML(Filename:=strTargetFile, LoadOption:=xlXmlLoadImportToList)
     Application.DisplayAlerts = True
     ‘清除格式
     wb.Sheets(1).UsedRange.ClearFormats
     wb.Sheets(1).UsedRange.Copy Workbooks(work_name).Sheets("CASHIER").range("A1")
     wb.Close False
     Application.ScreenUpdating = True
     
     ‘清除单元格的合并格式
End Function

7.发送邮件

‘发送邮件
        Dim OutlookObj As Object
        Dim OutlookNewMail As Object
        Set OutlookObj = CreateObject("Outlook.Application")
                      
        Set OutlookNewMail = OutlookObj.CreateItem(olMailItem)
        ‘关闭工作簿，便于发送邮件
       
        With OutlookNewMail
            .To = emailto
            .CC = emailcc
            .Subject = workname_arr(0) & " " & Sheets("emailContent").range("A1") & " " & date_for ‘邮件主题
            .HTMLBody = emailbody_arr(0) + emailbody_arr(1) + emailbody_arr(2) + emailbody_arr(3) + emailbody_arr(4) ‘邮件内容
            ‘读取源文件
            For Each fs In CreateObject("scripting.FileSystemObject").GetFolder(folderpath & "\").Files
                ‘读取GCR文件
                If fs.name Like "*" & workname_arr(0) & "*" & date_for & "*" Then
                    fs = CStr(fs)
                    .attachments.Add fs
                End If
            Next
            ‘邮件附件
            filePath = Sheets("emailContent").range("D3").Value
            For Each fs In CreateObject("scripting.FileSystemObject").GetFolder(filePath & "\").Files
                ‘读取GCR文件
                    fs = CStr(fs)
                    .attachments.Add fs
            Next
            .Display ‘发送邮件 display 为预览
        End With

8.VBA定时任务

Application.OnTime starttime + TimeValue("00:00:03"), "JV_Check" ‘3秒钟之后运行（若）设置为循环任务可以使用递归

9.VBA连接数据库

Dim cn As New ADODB.Connection ‘定义数据连接对象，保存数据库信息连接；先添加引用
    Dim rs As New ADODB.Recordset ‘定义记录集对象，保存数据表
    Dim cnStr As String, SQL As String
    
    ID = "10.250.0.000"
    Database = "test"
    PassWordChr = "123456"
    cnStr = "Provider=sqloledb;Server=" & ID & ";Database=" & Database & ";Uid=r2rtest;Pwd=" & PassWordChr & ";"
    cn.Open cnStr
    
    ‘先与JVQuery匹配数据，更新JVCheck表
    ‘SQL = "SELECT JVCheckList.id,JVCheckList.hotel,JVCheckList.type,JVCheckList.jvs,JVCheckList.[time],JVCheckList.ownerold,JVCheckList.ownernew,BU_HotelCode.IsorNot,JVCheckList.excelissuccess,JVCheckList.remark FROM JVCheckList LEFT JOIN ( JVQuerySummary LEFT JOIN BU_HotelCode ON JVQuerySummary.bu= BU_HotelCode.BU ) ON ( JVQuerySummary.transactionreference= JVCheckList.jvs AND BU_HotelCode.HotelCode= JVCheckList.hotel )"
    ‘SQL = "SELECT JVCheckList.id,JVCheckList.hotel,JVCheckList.type,JVCheckList.jvs,JVCheckList.[time],JVCheckList.ownerold,JVCheckList.ownernew,BU_HotelCode.IsorNot,JVCheckList.excelissuccess,JVCheckList.remark FROM JVCheckList LEFT JOIN ( JVQuerySummary LEFT JOIN BU_HotelCode ON JVQuerySummary.bu= BU_HotelCode.BU ) ON ( (JVQuerySummary.transactionreference like ‘%‘+JVCheckList.jvs+‘%‘) AND (BU_HotelCode.HotelCode= JVCheckList.hotel) )"
    SQL = "SELECT JVCheckList.id,JVCheckList.hotel,JVCheckList.type,JVCheckList.jvs,JVCheckList.[time],JVCheckList.ownerold,JVCheckList.ownernew,BU_HotelCode.IsorNot,JVCheckList.excelissuccess,JVCheckList.remark FROM JVCheckList LEFT JOIN ( JVQuerySummary LEFT JOIN BU_HotelCode ON JVQuerySummary.bu= BU_HotelCode.BU ) ON ( (replace(JVQuerySummary.transactionreference,‘ ‘,‘‘) like ‘%‘+replace(JVCheckList.jvs,‘ ‘,‘‘)+‘%‘) AND (BU_HotelCode.HotelCode= JVCheckList.hotel) ) "
    Set rs = cn.Execute(SQL)  ‘返回一个结果集
    ‘Do While Not rs.EOF  ‘指针未循环到结果集末尾时，循环
    ‘    rs.MoveNext  ‘将指针移向下一个
    ‘Loop
    If Not rs.EOF Then
        ThisWorkbook.Sheets("3月月结 Tax JV进度表").Range("A2:J2000").ClearContents
        ThisWorkbook.Sheets("3月月结 Tax JV进度表").Range("A2").CopyFromRecordset rs
    End If
    rs.Close
    cn.Close
    Set rs = Nothing
    Set cn = Nothing

10.Dictionary的使用

‘add的用法
For i = 2 To D_Maxrow
        D_Value = Sheet_lslj.Cells(i, "D").Value
        ‘判断是否存在某个键不存在则添加
        If D_dic.exists(D_Value) = False Then
              D_dic.Add D_Value, ""
        End If
Next i
‘遍历字典
‘遍历字典，对表格进行筛选，若存在的数据大于一行，则将其copy到报错Report中
            For Each Keys In D_dic
                Sheet_lslj.range("$A$1:$N$7").AutoFilter Field:=4, Criteria1:=Keys
                D_Maxrow2 = Sheet_lslj.range("D65535").End(xlUp).row
                ‘粘贴到另外一张表，进行中转
                Sheet_lslj.range("A2:N" & D_Maxrow2).Copy
                Sheet_Tmp.range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                D_Maxrow_T = Sheet_Tmp.range("D65535").End(xlUp).row
                
                
                If D_Maxrow_T > 1 Then
                    D_Maxrow_r = Sheet_bcReport.range("D65535").End(xlUp).row
                    Sheet_lslj.range("A2:N" & D_Maxrow2).Copy
                    Sheet_bcReport.range("A" & D_Maxrow_r + 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                    D_Maxrow_r = 0
                End If
                D_Maxrow2 = 0
                ‘清除中间表格
                Sheet_Tmp.range("A1:N65535").Clear
            Next Keys

原文：https://www.cnblogs.com/Gpengbolg/p/14990009.html