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

重複する電子メールを含む行を 1 つに結合し、列 B の情報をその電子メール アドレスの 1 つのレコードに結合する必要があります。いくつかのマクロを試しましたが、役に立ちませんでした。手伝って頂けますか？ここで少し混乱しています。ありがとう！

編集: 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 の [開発] タブの下に、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 に答える