Doppelte Zeilen mit eindeutigen Daten zusammenführen

Question

Wie werden doppelte Zeilen mit eindeutigen Daten zusammengeführt? (Mit Excel-VBA-Makro)

Aktuelle Tabelle:

<table><tbody><tr><th> </th><th>A</th><th>B</th><th>C</th><th>D</th><th>E</th><th>F</th><th>G</th><th>H</th><th>I</th><th>J</th><th>K</th></tr><tr><td>1</td><td>X</td><td>John</td><td> </td><td>K</td><td>City1</td><td>08</td><td>office</td><td> </td><td> </td><td>A</td><td> </td></tr><tr><td>2</td><td>X</td><td>John</td><td> </td><td>K</td><td>City1</td><td>14</td><td>office</td><td> </td><td> </td><td>A</td><td> </td></tr><tr><td>3</td><td>X</td><td>John</td><td> </td><td>K</td><td>City2</td><td> </td><td>office</td><td> </td><td> </td><td>A</td><td> </td></tr><tr><td>4</td><td>X</td><td>John</td><td> </td><td>K</td><td>City3</td><td> </td><td>office</td><td> </td><td> </td><td>A</td><td> </td></tr><tr><td>5</td><td>Y</td><td>Jack</td><td> </td><td>T</td><td>City1</td><td>06</td><td>office</td><td> </td><td> </td><td>A</td><td> </td></tr><tr><td>6</td><td>Y</td><td>Jack</td><td> </td><td>T</td><td>City1</td><td>12</td><td>firs office</td><td> </td><td> </td><td> </td><td> </td></tr><tr><td>7</td><td>Y</td><td>Jack</td><td> </td><td>T</td><td>City1</td><td>01</td><td>office</td><td> </td><td> </td><td>A+</td><td> </td></tr><tr><td>8</td><td>Z</td><td>Jennie</td><td> </td><td>K</td><td>City4</td><td> </td><td> </td><td> </td><td> </td><td>A</td><td>other</td></tr><tr><td>9</td><td>Z</td><td>Jennie</td><td> </td><td>K</td><td>City4</td><td> </td><td> </td><td> </td><td> </td><td>A</td><td>another</td></tr><tr><td>10</td><td>Z</td><td>Jennie</td><td> </td><td>T</td><td>City2</td><td> </td><td> </td><td> </td><td> </td><td>B</td><td> </td></tr><tr><td>11</td><td>Z</td><td>Jennie</td><td> </td><td>T</td><td>City2</td><td> </td><td> </td><td> </td><td> </td><td>A</td><td> </td></tr><tr><td>12</td><td>Z</td><td>Jennie</td><td> </td><td>T</td><td>City1</td><td>16</td><td> </td><td> </td><td> </td><td>B</td><td> </td></tr><tr><td>13</td><td>Z</td><td>Jennie</td><td> </td><td>T</td><td>City1</td><td>15</td><td> </td><td> </td><td> </td><td>A</td><td> </td></tr></tbody></table>

---

Wunsch (Grouping Tabelle):

<table><tbody><tr><th> </th><th>A</th><th>B</th><th>C</th><th>D</th><th>E</th><th>F</th><th>G</th><th>H</th><th>I</th><th>J</th><th>K</th></tr><tr><td>1</td><td>X</td><td>John</td><td> </td><td>K</td><td>City1</td><td>08;14</td><td>office</td><td> </td><td> </td><td>A</td><td> </td></tr><tr><td>2</td><td>Y</td><td>Jack</td><td> </td><td>T</td><td>City1</td><td>06;12;01</td><td>office;first office</td><td> </td><td> </td><td>A;A+</td><td> </td></tr><tr><td>3</td><td>Z</td><td>Jennie</td><td> </td><td>K;T</td><td>City4;City2;City1</td><td>15;16</td><td> </td><td> </td><td> </td><td>A;B</td><td>other;another</td></tr></tbody></table>

Jede Hilfe würde sehr geschätzt werden.

Answer 1

Arbeiten Sie in HTML oder ist das HTML eine Darstellung einer Excel-Tabelle? Wenn es Letzteres ist, könnten Sie ein Array von eindeutigen Werten aus der ersten Spalte erhalten und dann die Filter function verwenden, um die doppelten Werte zu durchlaufen und zu verketten.

Answer 2

Ich bin gelöst, danke für die Hilfe! Der Code:

Sub grouper() 
Dim EndRow As Integer, i As Integer 
Dim WS As Worksheet, WS2 As Worksheet 
Dim MyCell As Range 
Set WB = ActiveWorkbook 
Set WS = WB.Worksheets("Munka4") 
Set WS2 = WB.Worksheets("Munka7") 
EndRow = WS.Range("A65000").End(xlUp).Row 
Const StartRow = 1 
Set Rng = WS.Range(WS.Cells(StartRow, 1), WS.Cells(EndRow, 1)) 
i = 1 
For Each MyCell In Rng 
    Hit1R = Application.WorksheetFunction.Match(MyCell, Rng, 0) 
    MyCellRows = MyCell.Row 
    If MyCellRows = Hit1R Then i = i + 1 
    EndRow2 = WS2.Range("A65000").End(xlUp).Row + 1 
    If Hit1R = MyCellRows Then 
     WS2.Range("A" & i & ":K" & i) = WS.Range(WS.Cells(Hit1R, 1), WS.Cells(Hit1R, 11)).Value 
    Else 
     If InStr(1, WS2.Range("C" & i), WS.Cells(MyCellRows, 3), vbTextCompare) = 0 Then WS2.Range("C" & i) = WS2.Range("C" & i) & ";" & WS.Cells(MyCellRows, 3).Value 
     If InStr(1, WS2.Range("D" & i), WS.Cells(MyCellRows, 4), vbTextCompare) = 0 Then WS2.Range("D" & i) = WS2.Range("D" & i) & ";" & WS.Cells(MyCellRows, 4).Value 
     If InStr(1, WS2.Range("E" & i), WS.Cells(MyCellRows, 5), vbTextCompare) = 0 Then WS2.Range("E" & i) = WS2.Range("E" & i) & ";" & WS.Cells(MyCellRows, 5).Value 
     If InStr(1, WS2.Range("F" & i), WS.Cells(MyCellRows, 6), vbTextCompare) = 0 Then WS2.Range("F" & i) = WS2.Range("F" & i) & ";" & WS.Cells(MyCellRows, 6).Value 
     If InStr(1, WS2.Range("G" & i), WS.Cells(MyCellRows, 7), vbTextCompare) = 0 Then WS2.Range("G" & i) = WS2.Range("G" & i) & ";" & WS.Cells(MyCellRows, 7).Value 
     If InStr(1, WS2.Range("H" & i), WS.Cells(MyCellRows, 8), vbTextCompare) = 0 Then WS2.Range("H" & i) = WS2.Range("H" & i) & ";" & WS.Cells(MyCellRows, 8).Value 
     If InStr(1, WS2.Range("I" & i), WS.Cells(MyCellRows, 9), vbTextCompare) = 0 Then WS2.Range("I" & i) = WS2.Range("I" & i) & ";" & WS.Cells(MyCellRows, 9).Value 
     If InStr(1, WS2.Range("J" & i), WS.Cells(MyCellRows, 10), vbTextCompare) = 0 Then WS2.Range("J" & i) = WS2.Range("J" & i) & ";" & WS.Cells(MyCellRows, 10).Value 
     If InStr(1, WS2.Range("K" & i), WS.Cells(MyCellRows, 11), vbTextCompare) = 0 Then WS2.Range("K" & i) = WS2.Range("K" & i) & ";" & WS.Cells(MyCellRows, 11).Value 
    End If 
Next MyCell 

With WS2.Columns("A:K") 
.Replace What:=";;", Replacement:="", LookAt:=xlPart, _ 
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ 
    ReplaceFormat:=False 
.Replace What:=";", Replacement:="", LookAt:=xlWhole, _ 
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ 
    ReplaceFormat:=False 
End With 

End Sub