2016-12-22 2 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 
.. 

Das Ergebnis verketten, die Ich mag würde, ist bekommen:Excel: VBA mit mehreren Kriterien zum Nachschlagen und mehrere Datenbereiche in einzelne Zelle

 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 

    ... 

Ich habe hier VBA Fragen mehr gesehen verketten aber keine, die das Verketten zweier unterschiedlicher Datenbereiche beinhalten (Spalten B & C). Idealerweise werden die Ergebnisse durch Zeilen und nicht durch Zeilen getrennt (dh Alt + Enter), aber dies ist möglicherweise nicht möglich. Irgendwelche Hilfe geschätzt, danke.

Bearbeiten: Um zu verdeutlichen, ist das zweite Stück Code in einem separaten Arbeitsblatt.

+0

Das wäre eine Pivot-Tabelle mit Concatenate aggregate-Funktion. Soweit ich weiß, existiert es in Excel nicht - ich wünschte, es wäre so. In VBA ist es möglich. Was hast du bisher versucht? –

+0

Ich habe daran gearbeitet, den hier gefundenen Code für meine Zwecke zu ändern. –

+0

Ich habe daran gearbeitet, den hier gefundenen Code für meine Zwecke zu ändern. Http://www.extendoffice.com/documents/excel/2723-excel-concatenate-based-on-criteria.html. Leider macht die Verwendung mehrerer Kriterien UND das Verketten mehrerer Datenbereiche den Code wahrscheinlich so unterschiedlich, dass es einfacher ist, von vorne anzufangen. Ich bin ein absoluter Neuling bei VBA, der auch nicht ideal ist. –

Antwort

0

Versuchen Sie dies. Es nimmt ein zweites Blatt für die Ergebnisse

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 
Verwandte Themen