2

COL Aのすべてのインスタンスを調べ、COL Bのすべての値を1つの行に結合し、プロセスで重複を削除するMACROが必要です。カンマを追加することはプラスです。

VBAはわかりませんが、誰かが親切に説明してくれたら、学びたいです。これは私が必要とした最初のVBAソリューションではありません。ありがとう！

必要なものの例：

COL A    COL B 
100 ---- PC 245
100 ---- PC 246
100 ---- PC 247
101 ---- PC 245
101 ---- PC 246
101 ---- PC 247

の中へ

COL A    COL B 
100 ---- PC 245, PC 246, PC 247
101 ---- PC 245, PC 246, PC 247

このデータはマップに入るので、ツールチップテキスト用に連結する必要があります。どんな助けでも大歓迎です。ありがとう！

PS：必要なのはマクロです。私が必要としないのはピボットテーブルです。

4

2 に答える 2

4

モデレーターによって削除されたため、このコードを再投稿します。@ bill-the-lizard、それを再利用する前に、私の答えの何が問題になっているのかコメントできますか？

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)
        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-13T17:26:17.393 に答える
0

次のコードでは、「MicrosoftScriptingRuntime」への参照を追加する必要があります。

VBA Editor->Tools->References, Find and select Microsoft Scripting Runtime

「辞書」の代わりに「コレクション」を使用することが可能です。私は辞書が好きです。

コードはアクティブなワークシート（「DoLoop」）を読み取り、データをコピーします（プロセス内の重複を削除します）

次に、シート上のすべてのデータをクリアします。

次に、収集したデータをループして、空になったワークシートに出力します（「ForEach」ループ）

Sub Cat()
Dim Data As Dictionary
Dim Sheet As Worksheet

Set Sheet = ThisWorkbook.ActiveSheet
Set Data = New Dictionary

Dim Row As Integer
Dim Key As Variant
Dim Keys() As Variant
Dim Value As Variant
Dim Values() As Variant
Dim List As String

Row = 1

Do
    If Data.Exists(CStr(Sheet.Cells(Row, 1))) Then
        If Not Data(CStr(Sheet.Cells(Row, 1))).Exists(CStr(Sheet.Cells(Row, 2))) Then
            Data(CStr(Sheet.Cells(Row, 1))).Add (CStr(Sheet.Cells(Row, 2))), True
        End If
    Else
        Data.Add CStr(Sheet.Cells(Row, 1)), New Dictionary
        Data(CStr(Sheet.Cells(Row, 1))).Add (CStr(Sheet.Cells(Row, 2))), True
    End If
    Row = Row + 1
    If IsEmpty(Sheet.Cells(Row, 1)) Then
        Exit Do
    End If
Loop

Sheet.Cells.ClearContents

Keys = Data.Keys
Row = 1

For Each Key In Keys
    Values = Data(Key).Keys
    Sheet.Cells(Row, 1) = Key
    List = ""
    For Each Value In Values
        If List = "" Then
            List = Value
        Else
            List = List & ", " & Value
        End If
    Next Value
    Sheet.Cells(Row, 2) = List
    Row = Row + 1
Next Key

End Sub
于 2012-11-13T05:10:04.093 に答える