2016-12-22 5 views
0
 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 
.. 

Результат, который я хотел бы получить это:Excel: VBA для поиска с несколькими критериями и сцепить несколько диапазоны данных в одной ячейке

 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), но это может быть невозможно. Любая помощь приветствуется, спасибо.

Редактировать: Чтобы уточнить, вторая часть кода находится в отдельной рабочей таблице.

+0

Это будет сводная таблица с функцией агрегирования Concatenate. Насколько мне известно, в Excel этого не существует - я бы хотел. В VBA это возможно. что ты уже испробовал? –

+0

Я работаю над изменением кода, найденного здесь, в соответствии с моими целями. –

+0

Я работаю над изменением кода, найденного здесь, в соответствии с моими целями. Https: //www.extendoffice.com/documents/excel/2723-excel-concatenate-based-on-criteria.html. К сожалению, использование нескольких критериев и необходимость конкатенации нескольких диапазонов данных, вероятно, делает код таким разным, что проще начать с нуля. Я полный новичок в VBA, который тоже не идеален. –

ответ

0

Попробуйте это. Он принимает второй лист для результатов

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 

 Смежные вопросы

  • Нет связанных вопросов^_^