lookup 查询等级 在vba中的应用

2025-03-30 15:38:51
推荐回答(1个)
回答1:

Private Sub Q_Change()
Dim c As Object, fadd$
On Error Resume Next
'Price = Application.WorksheetFunction.Lookup(1, 0 / ((Worksheets("sheet1").Range("A2:A6") = P) * (Worksheets("sheet1").Range("C2:C6") <= Q)), Worksheets("sheet1").Range("B2:B6"))
If P <> "" And Q <> "" Then
With Sheet1.Range("A1:A6")
Set c = .Find(P, LookIn:=xlValues, LookAt:=xlWhole)
If Not c Is Nothing Then
fadd = c.Address
Do
Debug.Print Val(Q)
If Val(Q) >= c.Offset(, 2) And Val(Q) <= c.Offset(, 3) Then
Price.Caption = c.Offset(, 1) '价格
Exit Sub
Else
Set c = .FindNext(c)
End If
Loop While Not c Is Nothing And c.Address <> fadd
End If
End With
Else
Price.Caption = "" '数量空白,价格清空。
End If
End Sub

Private Sub UserForm_Initialize() '初始化
Dim dic As Object, i As Long
Set dic = CreateObject("scripting.dictionary") '字典
For i = 2 To 6 'Sheet1.[a65535].End(xlUp).Row 'A行最后一列非空白列
If Not dic.exists(Sheet1.Cells(i, 1).Value & "") Then dic.Add Sheet1.Cells(i, 1).Value, "" '非重复物料
Next i
P.List = Application.Transpose(dic.keys) '写入物料组合清单
Set dic = Nothing
End Sub