Question

我有一张大约50,000张这样的记录的excel表：

email   product  info   moreinfo
a@a.com   866   data   data1
b@b.com   960   data   data1
c@c.com   976   data   data1
c@c.com   884   data   data1
d@d.com   1010   data   data1
e@e.com   834   data   data1
f@f.com   981   data   data1
g@g.com   935   data   data1
g@g.com   832   data   data1
g@g.com   934   data   data1

我需要把它转换成这样的东西：

email   product   info   moreinfo
a@a.com   866   data   data1
b@b.com   960   data   data1
c@c.com   976,884   data   data1
d@d.com   1010   data   data1
e@e.com   834   data   data1
f@f.com   981   data   data1
g@g.com   935,832,934   data   data1

我需要将包含重复电子邮件的行合并为一个，并将B列中的信息合并到该电子邮件地址的一个记录中。我尝试了一些宏但无济于事。你能帮助我吗？我在这里有点困惑。谢谢！

编辑：我在Mac上使用Excel 2011。

Answer 1

试试这个宏：

Sub ConsolidateRows()
'takes rows and consolidate one or many cells, based on one or many cells matching with above or below rows.

Dim lastRow As Long, i As Long, j As Long
Dim colMatch As Variant, colConcat As Variant

'**********PARAMETERS TO UPDATE****************
Const strMatch As String = "A"    'columns that need to match for consolidation, separated by commas
Const strConcat As String = "B"     'columns that need consolidating, separated by commas
Const strSep As String = ", "     'string that will separate the consolidated values
'*************END PARAMETERS*******************

application.ScreenUpdating = False 'disable ScreenUpdating to avoid screen flashes

colMatch = Split(strMatch, ",")
colConcat = Split(strConcat, ",")

lastRow = range("A" & Rows.Count).End(xlUp).Row 'get last row

For i = lastRow To 2 Step -1 'loop from last Row to one

    For j = 0 To UBound(colMatch)
        If Cells(i, colMatch(j)) <> Cells(i - 1, colMatch(j)) Then GoTo nxti
    Next

    For j = 0 To UBound(colConcat)
        if len(Cells(i - 1, colConcat(j)))>0 then _
            Cells(i - 1, colConcat(j)) = Cells(i - 1, colConcat(j)) & strSep & Cells(i, colConcat(j))
    Next

    Rows(i).Delete

nxti:
Next

application.ScreenUpdating = True 'reenable ScreenUpdating
End Sub

Answer 2

以下VBA代码应该适用于您要执行的操作。它假定您的电子邮件地址在A2：A50000范围内，因此您可以根据需要进行更改。如果您对VBA不太熟悉，在Excel 2011 Mac的Developer Tab下，应该有一个名为Visual Basic Editor的图标。打开VB和CMD +单击窗口窗格并插入一个新模块。然后粘贴以下代码：

Sub combineData()
Dim xCell As Range, emailRange As Range
Dim tempRow(0 To 3) As Variant, allData() As Variant
Dim recordCnt As Integer

Set emailRange = Range("A2:A11")
recordCnt = -1

'LOOP THROUGH EACH CELL AND ADD THE DATE TO AN ARRAY
For Each xCell In emailRange
    'IF THE CELL IS EQUAL TO THE ONE ABOVE IT,
    'ADD THE PRODUCT NUMBER SEPARATED WITH A COMMA
    If xCell = xCell.Offset(-1, 0) Then
        tempRow(1) = tempRow(1) & ", " & xCell.Offset(0, 1).Value
        allData(recordCnt) = tempRow
    Else
        recordCnt = recordCnt + 1
        If recordCnt = 0 Then
            ReDim allData(0 To recordCnt)
        Else
            ReDim Preserve allData(0 To recordCnt)
        End If
        tempRow(0) = xCell.Value
        tempRow(1) = xCell.Offset(0, 1).Value
        tempRow(2) = xCell.Offset(0, 2).Value
        tempRow(3) = xCell.Offset(0, 3).Value
        allData(recordCnt) = tempRow
    End If
Next xCell

'CREATE A NEW WORKSHEET AND DUMP IN THE CONDENSED DATA
Dim newWs As Worksheet, i As Integer, n As Integer

Set newWs = ThisWorkbook.Worksheets.Add

For i = 0 To recordCnt
    For n = 0 To 3
        newWs.Range("A2").Offset(i, n) = allData(i)(n)
    Next n
Next i

End Sub

然后关闭VB，并单击Developer选项卡下的“Macros”按钮。然后运行combineData。这应该会给你你想要的结果。如果您有任何问题，请告诉我！

使用相同的电子邮件合并Excel文档中的行并保留合并的行数据

2 个答案: