0

我有大约 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。

4

2 回答 2

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
于 2012-11-06T18:21:49.183 回答
0

以下 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，然后单击“开发人员”选项卡下的“宏”按钮。然后运行 ​​combineData。这应该会给你你正在寻找的结果。如果您有任何问题，请告诉我！

于 2012-11-06T18:48:41.653 回答