Excel VBA高级编程 - 根据关键字自动搜索，自动生成下拉菜单

关注微信公众号：万能的Excel，回复关键词【下拉菜单】获取Excel源文件

功能说明：

因为工作需要，每一次都要从SAP查找物料信息，手动生成物料清单（Boom表），繁琐且容易出错。

使用VBA实现了如下功能：

1、根据关键字，自动检索符合条件的产品信息

2、自动生成下拉菜单

3、选定物料名称，其他产品信息将自动对应输入

1

附件代码：

Private Sub Worksheet_Change(ByVal Target As Range)
Dim whereStr$, sql$, conn, mr%, j%, k%, l%, n%
Dim i As Long, w1 As String
    j = Target.Row
    On Error Resume Next
    k = Application.WorksheetFunction.Match(Sheet6.Cells(Target.Row, 3), Sheet2.Range("D1:D103"), 0)
    l = Application.WorksheetFunction.Match(Sheet6.Cells(Target.Row, 2), Sheet2.Range("C1:C103"), 0)
    n = Application.WorksheetFunction.Match(Sheet6.Cells(Target.Row, 1), Sheet2.Range("b1:b103"), 0)
    If k > 0 And l = 0 Then
            Cells(Target.Row, 2) = Application.WorksheetFunction.Index(Sheet2.Range("C:C"), k)
    ElseIf k > 0 And l > 0 And n = 0 Then
        Cells(Target.Row, 1) = Application.WorksheetFunction.Index(Sheet2.Range("B:B"), k)
        
    ElseIf Target.Count = 1 And Not Intersect(Range("A3:C999"), Target) Is Nothing Then
        whereStr = whereStr & IIf(Cells(j, 1) = "", "", " and [Manufacturer] like '%" & Cells(j, 1) & "%'")
        whereStr = whereStr & IIf(Cells(j, 2) = "", "", " and [ID] like '%" & Cells(j, 2) & "%'")
        whereStr = whereStr & IIf(Cells(j, 3) = "", "", " and [Type] like '%" & Cells(j, 3) & "%'")
        mr = Sheet5.Cells(Rows.Count, 1).End(xlUp).Row
        If mr > 2 Then Sheet5.Range("A3:G" & mr).Clear
        If whereStr <> "" Then
            Set conn = CreateObject("ADODB.connection")
            conn.Open "Provider=Microsoft.Ace.oledb.12.0;extended properties='excel 12.0;HDR=yes';data source=" & ThisWorkbook.FullName
            sql = "select * from [产品库$B6:D] where" & Mid(whereStr, 5)
            [Search!A3].CopyFromRecordset conn.Execute(sql)
            conn.Close
            Set conn = Nothing
        End If
        
    End If


    w1 = ""


    With Sheet6


        ''首先创建下拉列表数据
        n = Sheet5.Range("c1").End(xlDown).Row()


        For i = 3 To n Step 1


            w1 = w1 & IIf(w1 <> "", ",", "")


            w1 = w1 & Trim$(Sheet5.Cells(i, 3))


        Next


        ''添加数据有效性
        


        With .Cells(j, 3).Validation
    
            .Delete
            
                If w1 <> "" And k = 0 Then
    
                    .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=w1
        
                    .InCellDropdown = True
                    
                End If
    
        End With


    End With
    
End Sub

关注微信公众号：万能的Excel，回复关键词【下拉菜单】获取Excel源文件