vba一些常用方法汇总（excel）

'根据指定字符返回行号

'DataName 要搜索的数据信息
'SearchRowCount 搜索的行高
'SearchColumnCount 搜索的列宽
'RowIndex 开始行
'ColumnIndex 开始列
Public Function ReTurnRowNum(ModuleActiveWorkBook As Workbook, SheetName As String, _
DataName As String, SearchRowCount As Integer, SearchColumnCount As Integer, _
Optional RowIndex As Integer = 1, Optional ColumnIndex As Integer = 1) As Integer

ModuleActiveWorkBook.Activate
Sheets(SheetName).Activate
Dim i As Integer
Dim j As Integer
Dim a As String
i = RowIndex
j = ColumnIndex
Do Until i > SearchRowCount
    For j = ColumnIndex To SearchColumnCount
    If Cells(i, j).Value = DataName Then  '更精准可以用Instr，多个条件，或者 用正则表达式
        If Cells(i, j).MergeCells = True Then
        ReTurnRowNum = i
            Exit Do
            Exit For
            Exit Do
        Else: ReTurnRowNum = 0
        End If
'    ElseIf Cells(i, j).Value = DataName And InStr(1, Cells(i, j).Value, "订单号", 0) = 0 And InStr(1, Cells(i, j).Value, "交货日期", 0) = 0 Then
'        ReTurnRowNum = i
'        Exit Do
'        Exit For
'        Exit Do
    Else: ReTurnRowNum = 0
    End If
    Next
    i = i + 1
Loop

End Function

参考;https://blog.csdn.net/bmjhappy/article/details/80512917

正则表达式：^[\s\S]*[L]+[C]+[S]+[\s]*[0-9]+[A]+[\s]*[D]+[A]+[T]+[A]+[\s\S]*$
正则表达式：^[\s\S]*[0-9a-zA-Z]+[楼]{1}[到]{1}[0-9]+[楼]{1}[的]{1}[楼]{1}[层]{1}[间]{1}[距]{1}[:]{1}[\s\S]*$

\w匹配的仅仅是中文，数字，字母，对于国人来讲，仅匹配中文时常会用到匹配中文字符的正则表达式：[\u4e00-\u9fa5]
或许你也需要匹配双字节字符，中文也是双字节的字符匹配双字节字符(包括汉字在内)：[^\x00-\xff]

'文件操作模块
'thisWorkbooks 代码所在excel工作簿
'ActivateWorkbook 当前活跃的excel工作簿

'当前打开的所有工作簿中，关闭指定工作簿
Public Sub CloseFile(FileName As String)
    Dim bk As Workbook
    For Each bk In Application.Workbooks
        If bk.name = FileName Then
            Workbooks(FileName).Save
            Workbooks(FileName).Close
        End If
    Next
End Sub
'将路径文件夹中的 条码.xlsx 文件删除
Public Sub DeleteFile()
    Dim CurrentFilePath As String: CurrentFilePath = ThisWorkbook.Path
    Dim myfile
    Dim day As String: day = Format(Now(), "YYYY-MM-DD")
    myfile = Dir(CurrentFilePath & "\*.xlsx") '提取文件路径中的所有文件，此时返回第一个文件的名字
    Do While myfile <> "" '当文件名不为空时，循环提取文件名
            If InStr(1, myfile, day, 0) > 0 Then 'Left(Name,Instr(name,".")-1)
                    Dim bk As Workbook
                    For Each bk In Application.Workbooks
                        If bk.name = myfile Then
                            Workbooks(myfile).Close
                        End If
                    Next
                    Kill CurrentFilePath & "\" & myfile
            End If
            myfile = Dir
    Loop
    MsgBox "删除完成"
End Sub
'将文件夹中所有文件名逐一写入到OrderFileName()数组中
Public Sub GetOrderFileNameToArray(OrderFilePath As String)
    Dim myfile
    Dim n As Integer: n = 1
    myfile = Dir(OrderFilePath & "\*.*") '提取文件路径中的所有文件，此时返回第一个文件的名字
        Do While myfile <> "" '当文件名不为空时，循环提取文件名
            ReDim Preserve OrderFileName(1 To n)
            OrderFileName(n) = myfile
            n = n + 1
            myfile = Dir
        Loop
End Sub


'按照OrderFileName()数组中的数据逐一生成excel sheet表
Public Sub CreateOrderSheet(SheetOrderFileName() As String, ModuleActiveWorkBook As Workbook)

ModuleActiveWorkBook.Activate
Dim UIndex As Integer
Dim i As Integer

UIndex = UBound(OrderFileName)
For i = 1 To UIndex
    Sheets("Sheet1").Copy Before:=Sheets("Sheet1")
    Dim name() As String
    name = Split(OrderFileName(i), ".")
    ActiveSheet.name = name(0)
    Sheets(name(0)).Tab.Color = 255
    
Next

End Sub

'文件复制

Public Sub ModuleFileCopy(SourceFilePath As String, DestinationFilePath As String)

FileCopy SourceFilePath, DestinationFilePath

End Sub

通过Access sql 的方式去处理数据。

Sub Select_Group1()

    Dim cnn As New ADODB.Connection   '创建Connection对象，该对象代表了Excel与后面指定数据库的连接
    Dim rst As ADODB.Recordset  '创建Recordset对象，该对象用来保存执行SQL语句后生成的数据集
    
    
    Dim SQL As String
    Dim i As Integer
    Dim mypath As String
    On Error GoTo ErrMsg    '
    mypath = ThisWorkbook.FullName
    cnn.Open "Provider=Microsoft.Ace.OLEDB.12.0;Extended Properties=Excel 12.0;Data Source=" & mypath   '使用Connection对象的Open方法来连接指定数据库与数据表的位置
    SQL = " select * from table1"
    Set rst = cnn.Execute(SQL)  '执行SQL语句
    Worksheets(2).Select
    Worksheets(2).Activate
    Worksheets(2).UsedRange.ClearContents
    'Cells.ClearContents ‘在Excel中放置数据
    For i = 0 To rst.Fields.Count - 1
        Cells(1, i + 1) = rst(i).name
    Next
    Range("a2").CopyFromRecordset rst
    rst.Close
    cnn.Close
    Set rst = Nothing
    Set cnn = Nothing
    Exit Sub
ErrMsg:
    MsgBox Err.Description, , "Description of Error"
End Sub

'根据指定字符返回数组 一维 杂项  这个是用正则表达式的


Public Function ReTurnArrayData(ModuleActiveWorkBook As Workbook, SheetName As String, RegPattern As String, _
 SearchRowCount As Integer, SearchColumnCount As Integer, _
Optional RowIndex As Integer = 1, Optional ColumnIndex As Integer = 1) As String()

ModuleActiveWorkBook.Activate
Sheets(SheetName).Activate
Dim i As Integer
Dim j As Integer

Dim a As String
i = RowIndex
j = ColumnIndex

Dim ReTurnArrayDataInFunc() As String
ReDim ReTurnArrayDataInFunc(1 To SearchColumnCount - 1) As String

Do Until i > SearchRowCount
    For j = ColumnIndex To SearchColumnCount
        Dim mRegExp As Object
        Dim mMatches As MatchCollection      '匹配字符串集合对象
        Dim mMatch As Match                  '匹配字符串
        Set mRegExp = New RegExp
        mRegExp.Global = True                              'True表示匹配所有, False表示仅匹配第一个符合项
            mRegExp.IgnoreCase = True                          'True表示不区分大小写, False表示区分大小写
            mRegExp.Pattern = RegPattern
        If mRegExp.Test(Cells(i, j).Value) Then
            Cells(i, j).Interior.ColorIndex = 42
            Dim ReTurnRowNumInFunc As Integer
                For ReTurnRowNumInFunc = 1 To SearchColumnCount - 1
                    ReTurnArrayDataInFunc(ReTurnRowNumInFunc) = Cells(i, ReTurnRowNumInFunc + 1).Value
                Next
            ReTurnArrayData = ReTurnArrayDataInFunc
            Exit Do
            Exit For
            Exit Do
        Else:
        End If
    Next
    i = i + 1
Loop
 Set mRegExp = Nothing
 Set mMatches = Nothing
End Function