关注微信公众号：万能的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 Stringj = Target.RowOn Error Resume Nextk = 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 ThenCells(Target.Row, 2) = Application.WorksheetFunction.Index(Sheet2.Range("C:C"), k)ElseIf k > 0 And l > 0 And n = 0 ThenCells(Target.Row, 1) = Application.WorksheetFunction.Index(Sheet2.Range("B:B"), k)ElseIf Target.Count = 1 And Not Intersect(Range("A3:C999"), Target) Is Nothing ThenwhereStr = 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).RowIf mr > 2 Then Sheet5.Range("A3:G" & mr).ClearIf whereStr <> "" ThenSet conn = CreateObject("ADODB.connection")conn.Open "Provider=Microsoft.Ace.oledb.12.0;extended properties='excel 12.0;HDR=yes';data source=" & ThisWorkbook.FullNamesql = "select * from [产品库$B6:D] where" & Mid(whereStr, 5)[Search!A3].CopyFromRecordset conn.Execute(sql)conn.CloseSet conn = NothingEnd IfEnd Ifw1 = ""With Sheet6''首先创建下拉列表数据n = Sheet5.Range("c1").End(xlDown).Row()For i = 3 To n Step 1w1 = w1 & IIf(w1 <> "", ",", "")w1 = w1 & Trim$(Sheet5.Cells(i, 3))Next''添加数据有效性With .Cells(j, 3).Validation.DeleteIf w1 <> "" And k = 0 Then.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=w1.InCellDropdown = TrueEnd IfEnd WithEnd WithEnd Sub
关注微信公众号：万能的Excel，回复关键词【下拉菜单】获取Excel源文件
