Question

如何将重复行与唯一数据合并？（使用excel VBA宏）

当前表：

＆＃13;

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

＆＃13;

所需（分组表）：

＆＃13;

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

＆＃13;

非常感谢任何帮助。

Answer 1

您是使用HTML还是HTML表示Excel电子表格？如果它是后者，您可以从第一列获得一组唯一值，然后使用Filter function循环并连接重复值。

Answer 2

我解决了，谢谢你的帮助！代码：

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

将重复行与唯一数据合并

2 个答案: