使用VBA在Excel中嵌套SQL Select查询

古马

我正在尝试在多个Excel工作表上进行SQL查询。

我有这样的设置(每个表是一个单独的工作表): 在此处输入图片说明

三个工作表-一个有条件,第二个有源数据,第三个有输出。

在输出中,我需要来自源的所有记录,其中ColumnA中的值在条件中出现在正数旁边。

我正在尝试做这样的事情:

Select * 
From [Source$] 
Where [ColumnA] In (
    Select [Column1] 
    From [Condition$] 
    Where [Column2] > 0
)

由于“条件”表中的值为空白,因此出现了第一个问题。如果该列-中有空白值,它将无法处理数字比较Data type mismatch in criteria expression现在,我通过做这个丑陋的事情来处理它:Where Column2 <> '' And Column2 <> '0'

但这不是主要问题。我有一个更大的问题,这与将一个“选择”嵌套到另一个内部有关。即使内部Select返回具有如下值的单列:

在此处输入图片说明

我仍然遇到错误Type mismatch in criteria expression.(与上面的错误略有不同)。

这样我就可以运行内部表达式了。我也可以使用硬编码值运行外部表达式(例如Where ColumnA In "'value1','value2',...")。但是当我嵌套它们时,我得到了错误。就我的SQL知识而言,我认为此查询应该有效,但是由于某些原因,excel中的内部查询返回的数据与in运算符不兼容

这是我的完整代码(由于这个SO答案):

Option Explicit
Private Const adCmdText As Long = 1
Private Const adStateOpen As Long = 1

Public Sub DisplayView()
    Dim dbField       As Variant
    Dim fieldCounter  As Long
    Dim dbConnection  As Object
    Dim dbRecordset   As Object
    Dim dbCommand     As Object
    Dim OutputSheet   As Excel.Worksheet

    Set dbConnection = CreateObject("ADODB.Connection")
    Set dbRecordset = CreateObject("ADODB.Recordset")
    Set dbCommand = CreateObject("ADODB.Command")

    Set OutputSheet = ThisWorkbook.Worksheets("Output")

    'Do a quick check to determine the correct connection string
    'if one of these don't work, have a look here --> https://www.connectionstrings.com/excel/
    If Left$(ThisWorkbook.FullName, 4) = "xlsm" Then
        dbConnection.connectionstring = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & _
        ThisWorkbook.FullName & ";Extended Properties='Excel 12.0 Macro;HDR=YES';"
    Else
        dbConnection.connectionstring = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & _
        ThisWorkbook.FullName & ";Extended Properties='Excel 12.0;HDR=YES';"
    End If

    'Open the connection and query
    dbConnection.Open
    With dbCommand
        .ActiveConnection = dbConnection
        .CommandType = adCmdText
        .CommandText = "Select * From [Source$] Where [ColumnA] In (Select [Column1] from [Condition$] where [Column1] > 0)"
        Set dbRecordset = .Execute
    End With

    'Clear the Output Sheet
    OutputSheet.Cells.Clear

    'Add Headers to output
    For Each dbField In dbRecordset.Fields
        fieldCounter = fieldCounter + 1
        OutputSheet.Cells(1, fieldCounter).Value2 = dbField.Name
    Next

    'Dump the found records
    OutputSheet.Range("A2").CopyFromRecordset dbRecordset
    If dbConnection.State = adStateOpen Then dbConnection.Close
End Sub


'Run from here
Public Sub ExampleRunner()
    Dim t As Double
    t = Timer
    DisplayView
    Debug.Print "Getting data took: " & Timer - t & " seconds"
End Sub

完善

可能是的NumberFormat列2条件片材被设置到GeneralText尝试将整个列(而不是子集范围)重新格式化为Number,然后保存更改,以便SQL引擎将数据类型识别为数字。从那里,您可以运行带有IN子句或更好的SQL查询,请使用INNER JOIN

SELECT s.[ColumnA], s.[ColumnB], s.[ColumnC], s.[ColumnD] 
FROM [Source$] s
WHERE s.[ColumnA] IN (
    SELECT [Column1] 
    FROM [Condition$] 
    WHERE [Column2] > 0
)

SELECT s.[ColumnA], s.[ColumnB], s.[ColumnC], s.[ColumnD] 
FROM [Source$] s
INNER JOIN [Condition$] c
  ON s.[ColumnA] = c.[Column1]
WHERE c.[Column2] > 0

此外,考虑处理任何格式(.xls, .xlsx, .xlsm, .xlsb的Excel ODBC驱动程序,如果不需要任何参数,请避免使用ADO命令对象:

Public Sub DisplayView()
    Dim dbConnection  As Object, dbRecordset As Object
    Dim strSQL        As String
    Dim dbField       As Variant, fieldCounter  As Long

    Set dbConnection = CreateObject("ADODB.Connection")
    Set dbRecordset = CreateObject("ADODB.Recordset")

    ' CONNECTION WITH EXCEL ODBC DRIVER
    dbConnection.Open "Driver={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)};" _
                          & "DBQ=" & ThisWorkbook.FullName & ";"

    strSQL = "SELECT s.[ColumnA], s.[ColumnB], s.[ColumnC], s.[ColumnD]" _
               & " FROM [Source$] s" _
               & " INNER JOIN [Condition$] c" _
               & "   ON s.[ColumnA] = c.[Column1]" _
               & " WHERE c.[Column2] > 0"

    ' OPEN RECORDSET
    dbRecordset.Open strSQL, dbConnection

    With Worksheets("Output")
        ' HEADERS
        For Each dbField In dbRecordset.Fields
            fieldCounter = fieldCounter + 1
            .Cells(1, fieldCounter).Value = dbField.Name
        Next dbField    
        ' DATA ROWS
        .Range("A2").CopyFromRecordset dbRecordset
    End With

    dbRecordset.Close: dbConnection.Close
    Set dbRecordset = Nothing: Set dbConnection = Nothing
End Sub

本文收集自互联网,转载请注明来源。

如有侵权,请联系 [email protected] 删除。

编辑于
0

我来说两句

0 条评论
登录 后参与评论

相关文章