Question

     A        B            C                ....      U
1    Length   Type         Program                    Category

2    <20m     Patrol       Ecuador (CG)               Red
3    <20m     Patrol       Kenya (Police)             Amber
4    <20m     Patrol       Uruguay                    Red
5    <20m     MCMV         France (Drone)             Red
6    <20m     Amphibious   Peru (ACV)                 Red
7    20-29m   Patrol       Bahrain (CG)               Amber
8    20-29m   Patrol       Denmark                    Amber
9    20-29m   Patrol       Latvia (BG)                Red
10   20-29m   Patrol       Latvia (CG)                Red
11   20-29m   Patrol       Lithuania (BG)             Amber
12   20-29m   Patrol       Norway                     Amber
..

我想得到的结果是：

      A         B                      C                        D 
  1   Length    Category Red           Category Amber           Category Green

  2   <20m      Patrol - Ecuador (CG)  Patrol - Kenya (Police)
                MCMV - France (Drone)
                etc....
  3   20-29m    Patrol - Latvia (BG)   Patrol - Bahrain (CG)
                Patrol - Latvia (CG)   Patrol - Denmark
                etc....                etc....
  4   30-39m

  ...

我在这里看到了几个连接的VBA问题，但没有涉及连接两个不同范围的数据（列B和C）。理想情况下，结果由行而不是行（即Alt + Enter）分隔，但这可能是不可能的。任何帮助表示感谢，谢谢。

编辑：为了澄清，第二段代码在一个单独的工作表中。

Answer 1

试试这个。它假定结果的第二张表

Sub x()

Dim vIn(), vOut(), i As Long, n As Long, vCol, j As Long

vIn = Sheet1.Range("A1").CurrentRegion.Value
ReDim vOut(1 To UBound(vIn, 1), 1 To 4)
vCol = Array("Red", "Amber", "Green")

With CreateObject("Scripting.Dictionary")
    For i = 2 To UBound(vIn, 1)
        j = Application.Match(vIn(i, 4), vCol, 0) + 1
        If Not .Exists(vIn(i, 1)) Then
            n = n + 1
            vOut(n, 1) = vIn(i, 1)
            vOut(n, j) = vIn(i, 2) & " - " & vIn(i, 3) & vbLf
            .Add vIn(i, 1), n
        ElseIf .Exists(vIn(i, 1)) Then
            vOut(.Item(vIn(i, 1)), j) = vOut(.Item(vIn(i, 1)), j) & vIn(i, 2) & " - " & vIn(i, 3) & vbLf
        End If
    Next i
End With

With Sheet2.Range("A1").Resize(n, 4)
    .ClearContents
    .Value = vOut
End With

End Sub

Excel：使用多个条件查找VBA并将多个数据范围连接到单个单元格

1 个答案: