Excel VBA中的VLookup无法正常工作
Excel文件格式
我有主数据表的属性ID是唯一的单位。 我有另一个表添加与属性相关联的产品值。
如果单位基于属性ID进行匹配，则单元格以绿色突出显示，否则显示为红色。
为了达到上述目的，我写了一些基本的代码，但似乎没有工作。 vlookup正常工作，但使用vba它只是退出。 请参阅下面的图像例如和代码。 列a和b包含属性主数据，列d包含产品属性值。
例如。 对于产品p1，值“IN”对属性“A1”有效，但“m”无效。 此外，可以有多个单位，每个属性用逗号分隔。 需要帮助来解决问题。
码：
Sub UnitCheck() Dim AttrIDrange As range, AttrIDcell As range Dim attrID Dim Lookup_Range As range Dim I, J As Variant Dim UNIT As Variant Set Lookup_Range = range("A2:B4") Set AttrIDrange = range("E1:G1") For Each AttrIDcell In AttrIDrange attrID = AttrIDcell.Value For I = 2 To 3 For J = 5 To 7 If Application.WorksheetFunction.VLookup(attrID, Lookup_Range, 2, False) = UNIT Then Worksheets("Sheet4").Cells(I, J).Font.Color = vbGreen Else Worksheets("Sheet4").Cells(I, J).Font.Color = vbRed End If Next Next Next End Sub 新情景：如果为任何属性定义了多个单位，则即使产品价值中只有一个单位出现，也应将其高亮显示为绿色。 如果1是正确的，rest是不正确的，那么因为它是部分正确的，它应该用红色甚至黄色突出显示。 请看图片。 需要帮助这种情况。
情景2图像
这是我认为OP所要求的东西。 此外，这replace三倍For/next和VLookUp字典，希望更适合。
关于OP，我看到两个基本的问题，UNIT从来没有分配过，但是，这听起来像=运算符是不正确的…相反，它听起来像查找值必须确认目前在一个逗号分隔的string。 下面的代码使用InStr来检查查找值是否存在。
Sub UnitCheck() Application.ScreenUpdating = False Dim UNIT As String Dim R, c, AttrID As Integer Dim ProdRange, ProdCell As Range Set ProdRange = Range("E2:G4") 'Assign LookUp values to array Dim LookUpArray(), ProdAttrIDArray() As Variant LookUpArray = Range("A2:B4").Value2 'Create dictionary from Lookup values Set D = CreateObject("Scripting.Dictionary") For R = 1 To UBound(LookUpArray) D.Add LookUpArray(R, 1), LookUpArray(R, 2) Next 'Loop through product table For Each ProdCell In ProdRange 'Get attribute ID from row 1 of corresponding column AttrID = Cells(1, ProdCell.Column).Value2 If D(AttrID) <> Empty Then 'If AttrID found in LookUp Dictionary then get UNIT from it UNIT = D(AttrID) 'If UNIT found in product cell then color cell green, else red If (InStr(1, ProdCell.Value2, UNIT) > 0) Then ProdCell.Interior.Color = vbGreen Else ProdCell.Interior.Color = vbRed End If End If Next End Sub
结果是这样的
新情景
好吧，我认为这将涵盖你的新情况。 请注意，我还添加了Trim()和VBTextCompare以便空格被忽略，比较是不区分大小写的。 我不确定你是否想要这种行为。 另外请注意，单位顺序无关紧要。 例如，“IN，km”匹配“KM，IN”，因为空格被忽略，大写被忽略，并且顺序被忽略。
Sub UnitCheck() Application.ScreenUpdating = False Dim UNIT, PUnits() As String Dim r, c, AttrID, i, n As Integer Dim ProdRange, ProdCell As Range Set ProdRange = Range("E2:G3") 'Assign LookUp values to array Dim LookUpArray(), ProdAttrIDArray() As Variant LookUpArray = Range("A2:B4").Value2 'Create dictionary from Lookup values Set D = CreateObject("Scripting.Dictionary") For r = 1 To UBound(LookUpArray) D.Add LookUpArray(r, 1), LookUpArray(r, 2) Next 'Loop through product table For Each ProdCell In ProdRange 'Get attribute ID from row 1 of correspdniong column AttrID = Cells(1, ProdCell.Column).Value2 If D(AttrID) <> Empty Then 'If AttrID found in LoopUp Dictionary then get UNIT from it UNIT = D(AttrID) PUnits = Split(ProdCell.Value2, ",") 'reset counter n = 0 'Count the number of product units found in the lookup value For i = 0 To UBound(PUnits) If InStr(1, Trim(UNIT), Trim(PUnits(i)), vbTextCompare) > 0 Then n = n + 1 End If Next 'prevent division by zero If i = 0 Then i = 1 'select action based on percent matched Select Case n / i Case Is >= 1 ProdCell.Interior.Color = vbGreen Case Is > 0 ProdCell.Interior.Color = vbYellow Case Else ProdCell.Interior.Color = vbRed End Select End If Next End Sub
在循环遍历I和J循环时，需要将UNIT设置为某些内容，然后才能将其与工作表VLOOKUP函数返回的结果进行比较。
Sub UnitCheck() Dim AttrIDrange As Range, AttrIDcell As Range Dim attrID Dim Lookup_Range As Range Dim I As Long, J As Long Dim UNIT As Variant Dim bCHECK_P1 With Worksheets("Sheet4") bCHECK_P1 = False Set Lookup_Range = .Range("A2:B4") Set AttrIDrange = .Range("E1:G1") For Each AttrIDcell In AttrIDrange '.Range("E1:G1") attrID = AttrIDcell.Value For I = 2 To 3 UNIT = AttrIDcell.Offset(I - 1, 0).Value '<~~ set UNIT here! For J = 5 To 7 .Cells(I, J).Font.Color = xlAutomatic If Application.WorksheetFunction.VLookup(attrID, Lookup_Range, 2, False) = UNIT Then .Cells(I, J).Font.Color = vbGreen Else .Cells(I, J).Font.Color = vbRed End If Next Next Next End With End Sub