将Excel文档中的行与同一电子邮件合并并保留合并行数据

将Excel文档中的行与同一电子邮件合并并保留合并行数据,excel,vba,Excel,Vba,我有一张excel表格,里面有大约50000条这样的记录: 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 98

我有一张excel表格,里面有大约50000条这样的记录:

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
我需要将其转换为如下内容:

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

试试这个宏:

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
Sub-ConsolidateRows()
'根据一个或多个与上面或下面行匹配的单元格,获取行并合并一个或多个单元格。
最后一行一样长,我一样长,j一样长
Dim colMatch作为变体,colConcat作为变体
“*******要更新的参数”****************
Const strMatch As String=“A”'需要匹配合并的列,以逗号分隔
Const strConcat As String=“B”'需要合并的列,以逗号分隔
Const strep As String=“,”字符串,用于分隔合并值
'*************结束参数*******************
application.ScreenUpdate=False“禁用屏幕更新以避免屏幕闪烁
colMatch=Split(标准格式,“,”)
colConcat=Split(strConcat,“,”)
lastRow=range(“A”&Rows.Count).End(xlUp).Row“获取最后一行”
对于i=lastRow到2步骤-1'循环,从最后一行到1
对于j=0到uBond(colMatch)
如果单元格(i,colMatch(j))单元格(i-1,colMatch(j)),则转到nxti
下一个
对于j=0至UBound(colConcat)
如果len(Cells(i-1,colConcat(j))大于0,那么_
细胞(i-1,colConcat(j))=细胞(i-1,colConcat(j))&strep和细胞(i,colConcat(j))
下一个
第(i)行。删除
nxti:
下一个
application.ScreenUpdate=True“可重新启动屏幕更新”
端接头

以下VBA代码适用于您尝试执行的操作。它假设您的电子邮件地址在A2:A50000范围内,因此您可以根据需要更改此地址。如果您不太熟悉VBA,在Excel 2011 Mac的“开发人员”选项卡下,应该有一个名为Visual Basic编辑器的图标。打开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,单击“开发人员”选项卡下的“宏”按钮。然后运行combineData。这会给你你想要的结果。如果你有任何问题,请告诉我

你可能想把这个问题带到一个完美的地方。先生,你是个天才。唯一的缺点是(我没有提到这一点)有时产品栏是空的。所以现在我得到了看起来像“,”的数据单元。如果B列中的单元格为空,是否有简单的修改方法来忽略这些单元格?