合并单元格后进行vlookup

Question

我有一个 VBA 代码，必须从几个不同的文件组中查找数据并对它们进行排序。最后，如果来自的两个文件之间的数据不同，则有一列将数据与“/”组合起来。合并后的数据位于单元格 C 中，到目前为止一切都运行良好。 我想用其中一个文件中 Sheet2 中的另一个数据库检查 C 列，但是我的代码仅返回 NA。我哪里错了？

这些是在sheet2 中提到的内容，并使用下一张图片上的数据进行vlookup 编辑

这是我正在使用的代码。

Sub PerformVLookup(mention As String, lookupRange2 As Range, lookupRange4 As Range, lookupRange2Sheet2 As Range, wsOutput As Worksheet, outputRow As Long)
    Dim lookupValue1 As String
    Dim lookupValue2 As String ' For the value in column C
    Dim lookupResult2 As Variant
    Dim lookupResult4 As Variant
    Dim lookupResultSheet2 As Variant ' Result for lookup in Sheet2
    Dim combinedResult As String
    
    lookupValue1 = Application.WorksheetFunction.Trim(Application.WorksheetFunction.Clean(CStr(mention)))
   
    ' Perform the VLOOKUP for this mention in Workbook2
    On Error Resume Next
    lookupResult2 = Application.VLookup(lookupValue1, lookupRange2, 2, False)
    On Error GoTo 0
    
    If IsError(lookupResult2) Then
        lookupResult2 = "#N/A"
    End If
    
    
    ' Perform the VLOOKUP for this mention in Workbook4
    On Error Resume Next
    lookupResult4 = Application.VLookup(lookupValue1, lookupRange4, 2, False)
    On Error GoTo 0
    
    If IsError(lookupResult4) Then
        lookupResult4 = "#N/A"
    End If
    
   ' Combine the results
    combinedResult = ""
    If lookupResult2 <> "#N/A" Then combinedResult = lookupResult2
    If lookupResult4 <> "#N/A" Then
        If combinedResult <> "" And combinedResult <> lookupResult4 Then
            combinedResult = combinedResult & " \ " & lookupResult4
        ElseIf combinedResult = "" Then
            combinedResult = lookupResult4
        End If
    End If
    
    ' If no matches, display #N/A
    If combinedResult = "" Then
        combinedResult = "#N/A"
    End If
    
    ' Output the final combined result in Column C
    wsOutput.Cells(outputRow, 3).Value = combinedResult
    
    ' If the combined result has "\", apply the color fill #FDBAB5 (light red)
    If InStr(combinedResult, "\") > 0 Then
        wsOutput.Cells(outputRow, 3).Interior.Color = RGB(253, 186, 181)
    End If
    
    ' Now perform the VLOOKUP for the value in column C in Workbook2 Sheet2
     If Not IsEmpty(wsOutput.Cells(outputRow, 3).Value) Then
        lookupValue2 = CStr(wsOutput.Cells(outputRow, 3).Value) ' Ensure lookupValue2 is a string
    On Error Resume Next
    lookupResultSheet2 = Application.VLookup(lookupValue2, lookupRange2Sheet2, 2, False)
    On Error GoTo 0
    
    If IsError(lookupResultSheet2) Then
        lookupResultSheet2 = "#N/A"
    End If
    
    ' Output the result from Workbook2 Sheet2 in column D
    wsOutput.Cells(outputRow, 4).Value = lookupResultSheet2
    Else
        ' If column C is empty, output NA in column D
        wsOutput.Cells(outputRow, 4).Value = "#N/A"
    End If
End Sub

Answer 1

不是解决您眼前的问题，而是一些建议，通过将常见的逻辑/功能分解为可以重复使用的单独方法来减少大量代码。

（未经测试）

Sub PerformVLookup(mention As String, lookupRange2 As Range, lookupRange4 As Range, lookupRange2Sheet2 As Range, wsOutput As Worksheet, outputRow As Long)
    Const NO_MATCH As String = "#N/A"  'use Const for fixed values
    
    Dim lookupValue1 As String, lookupValue2 As String ' For the value in column C
    Dim lookupResult2 As Variant, lookupResult4 As Variant, lookupResultSheet2 As Variant
    Dim combinedResult As String, c As Range
    
    '## are you sure this gives a value which can be matched to the other sheets? ##
    lookupValue1 = Application.WorksheetFunction.Trim(Application.WorksheetFunction.Clean(CStr(mention)))
   
    ' Perform the VLOOKUP for this mention in Workbook2
    lookupResult2 = VLookupOrDefault(lookupValue1, lookupRange2, 2, NO_MATCH)
    lookupResult4 = VLookupOrDefault(lookupValue1, lookupRange4, 2, NO_MATCH)
    
    combinedResult = CombineUniquesOrDefault(" \ ", NO_MATCH, NO_MATCH, lookupResult2, lookupResult4)
    
    ' Output the final combined result in Column C
    Set c = wsOutput.Cells(outputRow, 3)
    c.Value = combinedResult
    If InStr(combinedResult, "\") > 0 Then c.Interior.Color = RGB(253, 186, 181)
    
    ' Now perform the VLOOKUP for the value in column C in Workbook2 Sheet2
     If Len(c.Value) > 0 Then
        wsOutput.Cells(outputRow, 4).Value = _
            VLookupOrDefault(CStr(c.Value), lookupRange2Sheet2, 2, NO_MATCH )
    Else
        ' If column C is empty, output NA in column D
        wsOutput.Cells(outputRow, 4).Value = NO_MATCH 
    End If
End Sub

'Perform a vlookup and return `defaultValue` if there's no match
Function VLookupOrDefault(lookupValue, lookupRange As Range, colNum, Optional defaultValue)
    VLookupOrDefault = Application.VLookup(lookupValue, lookupRange, 2, False)
    If IsError(VLookupOrDefault) And Not IsMissing(defaultValue) Then VLookupOrDefault = ""
End Function

'Combine all unique values passed to `values()`, except for any value matching `ignoreValue`
'  Return unique values joined by `sep`.  If there are no values to return then return `defaultValue`
Function CombineUniquesOrDefault(sep As String, ignoreValue As String, _
                                defaultValue As String, ParamArray values()) As String
    Dim dict As Object, el
    Set dict = CreateObject("scripting.dictionary")
    For Each el In values
        If el <> ignoreValue Then dict(el) = True
    Next el
    If dict.Count > 0 Then
        CombineUniquesOrDefault = Join(dict.Keys, sep)
    Else
        CombineUniquesOrDefault = defaultValue
    End If
End Function