因为工作需要，每一次都要从SAP查找物料信息，手动生成物料清单（Boom表），繁琐且容易出错。
使用VBA实现了如下功能：
1、根据关键字，自动检索符合条件的产品信息
2、自动生成下拉菜单
3、选定物料名称，其他产品信息将自动对应输入
附件代码：
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
