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

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