比较两列中的值，返回第三列中的匹配项

Question

巴士路线编号列在A栏中。路线所服务的目的地列在B栏和C栏中。我想要的是查找由相同巴士路线服务的所有目的地，然后返回具有相应巴士路线的目的地，如图所示在这里：

Answer 1

附加的代码应该为您做到：

Sub Reformat()
Dim lLastRow As Long, lRowLoop As Long
Dim shtOrg As Worksheet, shtDest As Worksheet, lCountDest As Long, lCountRoutes As Long

Set shtOrg = ActiveSheet
Set shtDest = Worksheets.Add

'turn off updates to speed up code execution
With Application
    .ScreenUpdating = False
    .EnableEvents = False
    .Calculation = xlCalculationManual
    .DisplayAlerts = False
End With


lLastRow = shtOrg.Cells(Rows.Count, 1).End(xlUp).Row

shtOrg.Range("A1:B" & lLastRow).Copy shtDest.Cells(1, 1)
shtOrg.Range("A2:A" & lLastRow & ",C2:C" & lLastRow).Copy shtDest.Cells(lLastRow + 1, 1)

With shtDest

    lLastRow = .Cells(Rows.Count, 1).End(xlUp).Row

    .Range("$A$1:$B$" & lLastRow).RemoveDuplicates Columns:=Array(1, 2), Header _
            :=xlYes

    .Range("$B$1:$B$" & lLastRow).Copy .Range("G1")

    .Range("$G$1:$G$" & lLastRow).RemoveDuplicates Columns:=Array(1), Header:=xlYes

    lCountDest = .Cells(Rows.Count, "G").End(xlUp).Row - 1

    .[h1].FormulaArray = "=MAX(COUNTIF(R2C2:R" & lLastRow & "C2,R2C7:R" & lCountDest & "C7))"

    Application.Calculate

    lCountRoutes = [h1].Value

    With .Range("H1", .Cells(1, 7 + lCountRoutes))
        .FormulaR1C1 = "=""Route "" & column()-7"
        .Value = .Value
    End With


    .Range("H2", .Cells(lCountRoutes + 3, 7 + lCountRoutes)).FormulaR1C1 = "=LARGE(IF(R2C2:R" & lLastRow & "C2=RC7,R2C1:R" & lLastRow & "C1,0),COLUMN()-7)"
    .Range("H2", .Cells(lCountRoutes + 3, 7 + lCountRoutes)).FormulaArray = .Range("H2", .Cells(lCountRoutes + 3, 7 + lCountRoutes)).FormulaR1C1

    Application.Calculate

    .Range("H2", .Cells(lCountRoutes + 3, 7 + lCountRoutes)).Value = .Range("H2", .Cells(lCountRoutes + 3, 7 + lCountRoutes)).Value

    .Columns("A:F").Delete

    .Cells.Replace What:="0", Replacement:="", LookAt:=xlWhole, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
End With

With Application
    .ScreenUpdating = True
    .EnableEvents = True
    .Calculation = xlCalculationAutomatic
    .DisplayAlerts = True
End With


End Sub