如何找到两列数据如果找到则第三列找到数据

时间:2015-11-26 17:04:48

标签: excel vba

请找到图片,我们会找到所有相关信息,抱歉无法解释,但我在图片中解释请帮帮我,请你

enter image description here

1 个答案:

答案 0 :(得分:0)

所以我试着按照你的照片,我有同样的问题,因为我使用这个功能。

所以你应该将两个代码放在同一个模块中。我还尊重你在图片中展示的专栏。

我希望它会对你有所帮助。

<强> 编辑:

 Sub test()
    Dim Lastrow As Long
    Dim cell As Range
    Dim rng As Range
    Dim Lastrow2 As Long, Lastrow3 As Long


    With ThisWorkbook.Worksheets("Sheet1")

        Lastrow = Application.Max(.Cells(.Rows.count, "A").End(xlUp).Row)

        .Range("B2:B" & Lastrow).Value = .Range("A2:A" & Lastrow).Value

        For Each cell In .Range("B2:B" & Lastrow)
            If cell.Value = "" Then
                If rng Is Nothing Then
                    Set rng = cell
                Else
                    Set rng = Union(rng, cell)
                End If
            End If
        Next

        If Not rng Is Nothing Then rng.Delete Shift:=xlUp
    End With

Lastrow2 = Range("B" & Rows.count).End(xlUp).Row
Lastrow3 = Range("E" & Rows.count).End(xlUp).Row

For i = 2 To Lastrow2

Range("G" & i) = Range("B" & i) & " " & LookUpConcat(Range("B" & i), Range("D1:" & "D" & Lastrow3), Range("E1:" & "E" & Lastrow3), ",")

Next i

   End Sub

这里的功能:

Function LookUpConcat(ByVal SearchString As String, SearchRange As Range, ReturnRange As Range, _
                      Optional Delimiter As String = " ", Optional MatchWhole As Boolean = True, _
                      Optional UniqueOnly As Boolean = False, Optional MatchCase As Boolean = False)

  Dim X As Long, CellVal As String, ReturnVal As String, Result As String

  If (SearchRange.Rows.count > 1 And SearchRange.Columns.count > 1) Or _
     (ReturnRange.Rows.count > 1 And ReturnRange.Columns.count > 1) Then
    LookUpConcat = CVErr(xlErrRef)
  Else
    If Not MatchCase Then SearchString = UCase(SearchString)
    For X = 1 To SearchRange.count
      If IsError(SearchRange(X)) Then GoTo Continue
      If MatchCase Then
        CellVal = SearchRange(X).Value
      Else
        CellVal = UCase(SearchRange(X).Value)
      End If
      ReturnVal = ReturnRange(X).Value
      If MatchWhole And CellVal = SearchString Then
        If UniqueOnly And InStr(Result & Delimiter, Delimiter & ReturnVal & Delimiter) > 0 Then GoTo Continue
        Result = Result & Delimiter & ReturnVal
      ElseIf Not MatchWhole And CellVal Like "*" & SearchString & "*" Then
        If UniqueOnly And InStr(Result & Delimiter, Delimiter & ReturnVal & Delimiter) > 0 Then GoTo Continue
        Result = Result & Delimiter & ReturnVal
      End If
Continue:
    Next

    LookUpConcat = Mid(Result, Len(Delimiter) + 1)
  End If
End Function