VBA与数据库——简化程序编写-筛选

Sub FilterData()
    Dim arr() As Variant
    '读取数据源
    arr = Range("A1").CurrentRegion.Value
    
    '记录需要筛选的数据需要放到arr中的行号
    '共用arr空间
    Dim prow As Long
    prow = 2
    
    Dim i As Long
    For i = 2 To UBound(arr)
        '筛选项目包含s的
        If VBA.InStr(arr(i, 1), "s") Then
            '复制数据
            arr(prow, 1) = arr(i, 1)
            arr(prow, 2) = arr(i, 2)
            
            prow = prow + 1
        End If
    Next
    
    '输出
    Range("D1").Resize(prow - 1, 2).Value = arr
End Sub

If VBA.InStr(arr(i, 1), "s") Then

Sub ADOFilterData()
    Dim AdoConn As Object
    Set AdoConn = VBA.CreateObject("ADODB.Connection")
    
    '打开数据库
    AdoConn.Open "Provider =Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=""Excel 12.0;HDR=YES"";"
    Range("D2").CopyFromRecordset AdoConn.Execute("select * from [Sheet1$A1:B5] where 项目 like '%s%'", , 1)

    AdoConn.Close
    Set AdoConn = Nothing
End Sub