求教通过VBA实现多条件筛选后引用数据

yynrzwh

liushilin 发表于 2025-3-14 09:00
老师，代码运行提示编译错误，next没有for, 是我录入代码时哪里出错了吗，麻烦看下。谢谢

set d(s)这句你换行了。
要么不换行，要么在后面加endif.
下面那个if一样。

liushilin

老师，能不能把你写的原码发出来？

romecyf

你表二中筛选数据的条件应该是按符合数量的施工单位按优先顺序由甲单位或空值-----乙单位或丙单位,但你的例子却完全不符合你自己提出的筛选要求，例如J05010303193 按表二判断一筛选后,施工单位优先应该是空值,且剩余库存15947大于计划领用数量1562,完全符合判断一应是应该是,施工单位为空值剩余库存15947,但例子中却选最大剩余库存是丙单位,

romecyf

这个VBA是完全按你出的表2筛选条件做判断,如有不符合的自己修改
Sub romecyf()
Dim Conn As Object, Rst As Object
     Dim strConn As String, strSQL As String
     Dim i As Integer, PathStr As String
     Set Conn = CreateObject("ADODB.Connection")
     Set Rst = CreateObject("ADODB.Recordset")
     PathStr = ThisWorkbook.FullName   '设置工作簿的完整路径和名称
     Select Case Application.Version * 1    '设置连接字符串,根据版本创建连接
     Case Is <= 11
         strConn = "Provider=Microsoft.Jet.Oledb.4.0;Extended Properties=excel 8.0;Data source=" & PathStr
     Case Is >= 12
         strConn = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & PathStr & ";Extended Properties=""Excel 12.0;HDR=YES"";"""
     End Select
     '设置SQL查询语句
     Conn.Open strConn    '打开数据库链接
    With ActiveSheet
        For i = 2 To 5
             If .Cells(i, 7) <> 0 Then
                ID = .Cells(i, 4)
                SL = .Cells(i, 7)
               strSQL = "select top 1 采购需求号,需求号,WBS元素,项目负责人,剩余库存,施工单位 from [表二$] where 物料编号='" & ID & "' and 剩余库存>=" & SL & " and (施工单位='甲单位' or 施工单位 is null) order by 剩余库存 desc "
                Set Rst = Conn.Execute(strSQL)
                If Not Rst.EOF Then GoTo 99
               strSQL = "select top 1 采购需求号,需求号,WBS元素,项目负责人,剩余库存,施工单位 from [表二$] where 物料编号='" & ID & "' and 剩余库存>=" & SL & " and (施工单位='乙单位' or 施工单位='丙单位') order by 剩余库存 desc"
                Set Rst = Conn.Execute(strSQL)
                If Not Rst.EOF Then GoTo 99
               strSQL = "select top 1 采购需求号,需求号,WBS元素,项目负责人,剩余库存,施工单位 from [表二$] where 物料编号='" & ID & "' order by 剩余库存 desc"
                Set Rst = Conn.Execute(strSQL)
                If Not Rst.EOF Then GoTo 99
99           .Range("H" & i).CopyFromRecordset Rst
             Rst.Close    '关闭数据库连接
            End If
        Next i
    End With
    Conn.Close
     Set Conn = Nothing
     Set Rst = Nothing
End Sub