2012-11-06 34 views
0

我有大約50,000記錄的是這樣的一個Excel工作表:同一個電子郵件的Excel文檔中的合併行和保存合併的行數據

email product info moreinfo 
[email protected] 866 data data1 
[email protected] 960 data data1 
[email protected] 976 data data1 
[email protected] 884 data data1 
[email protected] 1010 data data1 
[email protected] 834 data data1 
[email protected] 981 data data1 
[email protected] 935 data data1 
[email protected] 832 data data1 
[email protected] 934 data data1 

我需要將其轉換爲這樣的事情:

email product info moreinfo 
[email protected] 866 data data1 
[email protected] 960 data data1 
[email protected] 976,884 data data1 
[email protected] 1010 data data1 
[email protected] 834 data data1 
[email protected] 981 data data1 
[email protected] 935,832,934 data data1 

我需要將具有重複電子郵件的行合併爲一個,並將來自列B的信息合併到該電子郵件地址的一個記錄中。我嘗試了一些宏,但無濟於事。你可以幫我嗎?我在這裏有點困惑。謝謝!

編輯:我在Mac上使用Excel 2011。

+0

你可能想把這個問題提交到http://superuser.com/ – Ali

回答

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

這已經很完美了。你先生,是個天才。唯一的缺點是(我沒有提到這一點)有時產品欄是空的。所以現在我得到的數據單元看起來像「,,」。是否有任何簡單的方法可以修改它以忽略列B中的單元格,如果它們是空的? –

+0

相應地調整了代碼 – nutsch

0

以下VBA代碼應你正在嘗試做的工作。它假定您的電子郵件地址在A2:A50000範圍內,因此您可以更改以符合您的需求。如果您對VBA不太熟悉,則在Excel 2011 Mac的「開發人員」選項卡下,應該有一個名爲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。這應該給你你想要的結果。讓我知道你是否有麻煩!

相關問題