lookup 查询等级 在vba中的应用
我需要在vba中套用一个lookup查询等级的函数,就是一个数据分段对应一个等级,但是在vba中,lookup函数的比较数据大小的大括号显示为无效符号啊,求解怎么办。...
我需要在vba中套用一个lookup查询等级的函数,就是一个数据分段对应一个等级,但是在vba中,lookup函数的比较数据大小的大括号显示为无效符号啊,求解怎么办。
展开
2017-07-04
展开全部
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
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
推荐律师服务:
若未解决您的问题,请您详细描述您的问题,通过百度律临进行免费专业咨询