Question

我遇到了问题（否则我不会在这里）:)）

在Excel中，我有一个项目编号列表，如果它们已经存在于数据库中，则需要进行检查。目前，唯一的方法是在单独的工作表中运行查询以获取所有项目编号（400,000+），这需要相当长的时间，并且每次都必须完成。

我已经启动了一个vba查询，该查询遍历所选的每个单元格并检查该值以查看它是否存在于数据库中。如果存在，则单元格变为红色。如果它不存在，则单元格变为绿色。在使用VBA查询数据库时，我并不是那么好，所以我使用了我在网上找到的点点滴滴。

当我去测试它时，Excel崩溃并关闭，所以我无法确定它出错的地方。

Public Sub CheckItemNoExist()
Dim DB As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim c As Range
Dim ItemNum As Variant
Dim bFound As Boolean

DB.Open "DSN=DBNAME;UID=****;PWD=****;"

Set rs = DB.OpenRecordset("SELECT [Inventory.ITM_NO] FROM [OAUSER.Inventory] WHERE [Inventory.ITM_NO]=" & ItemNum & ";", dbOpenDynaset)

For Each c In ActiveSheet.Selection
ItemNum = c.Value
bFound = Not rs.EOF
If bFound Then
c.Interior.Color = RGB(255, 0, 0)
Else
c.Interior.Color = RGB(0, 255, 0)
End If
Next

rs.Close
Set rs = Nothing
DB.Close
Set DB = Nothing

End Sub

谢谢！马特

Answer 1

我建议你在where子句中使用IN来覆盖选择中的所有项目，然后过滤每个项目的记录集以查看它是否找到它。我没有你的数据设置，所以我使用了一个方便的卡车数据库。你应该能够转换

Sub CheckTruckExists()

    Dim cn As ADODB.Connection
    Dim rs As ADODB.Recordset
    Dim sSql As String
    Dim aInClause() As String
    Dim rCell As Range
    Dim vaTrucks As Variant
    Dim i As Long

    'Open a connection to the database
    Set cn = New ADODB.Connection
    cn.Open sCONNECTIONSTRING

    'Get an array of values from the selection
    vaTrucks = Selection.Value
    'Increase the size of the one-dimensional array to match
    ReDim aInClause(LBound(vaTrucks, 1) To UBound(vaTrucks, 1))

    'Fill a one-dim array from the two-dim array so we can Join it
    For i = LBound(vaTrucks, 1) To UBound(vaTrucks, 1)
        aInClause(i) = vaTrucks(i, 1)
    Next i

    'Build the SQL statement and execute it
    sSql = "SELECT ReportTruck FROM qryTrucks WHERE ReportTruck IN ('" & Join(aInClause, "','") & "')"
    Set rs = New Recordset
    Set rs = cn.Execute(sSql)

    'Loop through the selected cells
    For Each rCell In Selection.Cells
        'clear the filter, then refilter the recordset on the filtered value
        rs.Filter = adFilterNone
        rs.Filter = "ReportTruck = '" & rCell.Value & "'"

        'If the filter returned zero records, it's eof
        If rs.EOF Then
            rCell.Interior.Color = RGB(255, 0, 0)
        Else
            rCell.Interior.Color = RGB(0, 255, 0)
        End If
    Next rCell

End Sub

我的ReportTruck字段是一个字符串，所以我必须用单引号将所有卡车包含在我的IN子句中。如果您正在寻找除String之外的其他内容，请修改Join以适应该数据类型。

此外，没有错误检查以确保Selection实际上是一个Range对象，或者它包含多个单元格 - 两者都是避免错误所必需的。

Excel VBA检查ODBC连接数据库中是否存在值范围

1 个答案: