複数の行の内容を1つのセルに追加し、Excel 2010で3番目の行でグループ化する方法

0

異なる行から複数の名前を1つの行の1つのセルに取得しようとしていますが、別の列の値でグループ化します。また、名前のリストには、コンマ区切りのリストではなく、名前の間に改行を入れる必要があります。これが可能になるかどうかはわかりません。= CONCATENATE（TRANSPOSE（B2：B19））のようにデータを1つのセルに入れ、char（10）で改行を追加するなど、必要なものをいくつか持っていますが、できませんでした私が欲しいものを得るためにそれをまとめること。

現在、データは次のようになっています。

私が欲しいもの：

VBAソリューションでさえも大丈夫-それは私の得意ではありませんが。;）Wordの差し込み印刷で使用するには、このようなデータが必要です。

また、スプレッドシートにはさらにいくつかのデータ列があることに注意してください。簡単にするために省略しました。

— グレック
ソース

2

VBAを少し必要とするソリューションをお勧めします。

この例では、サンプルデータはB2：C10にあります。E1を見出しセルのままにして、E2に次の数式を入力し、数式バー内でCtrl + Shift + Enterを押して配列数式を作成します。数式は中括弧で囲まれ、配列数式であることを示します。

=IFERROR(INDEX($B$2:$B$10, MATCH(0, COUNTIF(E$1:$E1, $B$2:$B$10), 0),1),"")

空白になるまでこれを下にドラッグします。これにより、B2：B10のグループから一意の値のリストが最初に作成されます。この数式を配置する場所はどこでも、少なくとも1つのセルが参照可能になっている必要があります。この場合のE1は、式がE2で始まるためです。

TEXTJOINと呼ばれる関数を使用します。ただし、Excelのほとんどのバージョンではこれは利用できません。Excel 2016のOffice 365バージョンを使用している場合に使用できます。使用できない場合は、VBAでUDF（ユーザー定義関数）を使用して同じ機能を複製します。

Alt + F11を押してVBAエディターにアクセスします。[挿入]メニューからモジュールを挿入します。次のUDFを入れます。

Function TEXTJOIN1(delimiter As String, ignore_empty As Boolean, ParamArray cell_ar() As Variant)
For Each cellrng In cell_ar
    For Each cell In cellrng
        If ignore_empty = False Then
            result = result & cell & delimiter
        Else
            If cell <> "" Then
                result = result & cell & delimiter
            End If
        End If
    Next cell
Next cellrng
TEXTJOIN1 = Left(result, Len(result) - Len(delimiter))
End Function

Excelシートに戻り、この関数を数式のUDFとして使用します。F2で次の式を入力し、CTRL + SHIFT + ENTERを押して配列式を作成します。

=IFERROR(TEXTJOIN1(CHAR(10),TRUE,IF($B$2:$B$10=E2,$C$2:$C$10,"")),"")

目的の行までドラッグします。これは、Char（10）によって連結されたグループごとに名前のリストを作成しますが、正しい効果を確認するには、目的のセルでテキストの折り返しを有効にする必要があります。Excelの[セルの書式設定]オプションから手動で実行するか、以下の簡単なマクロを使用して実行できます。最初に範囲を指定するだけです。この例では、E2：F4です。

Alt + F11を押してVBAエディターにアクセスします。挿入メニューからモジュールを挿入し、次のコードを貼り付けます。これにより、Format1という名前のマクロが作成されます

サブフォーマット1（）

    Range("E2:F4").Select
    With Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlTop
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
End Sub

Excelシートに戻るAlt + F8キーを押して、[マクロ]ダイアログボックスにアクセスし、Format1を実行します。

このソリューションを最後にテストし、問題が発生した場合はお知らせください。

— パトキム
ソース

ありがとう！これもうまくいくようです。私が戻って答えを確認する前に、別の解決策を見つけることができました。

— グレック

2

投稿した後、他の回答を見る前に、同僚と仕事をしました。

グループ、次に名前でソートして開始しました。

次に、名前が既に追加されているか（重複があるか）、グループが同じか異なるかを確認する列を追加しました。その名前がまだ追加されておらず、それでも同じグループである場合は、次を使用して、上のセルのリストに新しい名前を連結しました。

=IF(B2=B1,C1,IF(A2=A1,CONCATENATE(C1,CHAR(10),B2),B2))

別の列では、グループ内の名前の実行逆カウントを作成しました。

=IF(A2=A1,D1-1,COUNTIF(A:A,A2))

これはこれを得ました：

次に、列Dを「1」でフィルタリングしました。

— グレック
ソース

0

Private Sub MergeDuplicates()


Dim Rng As Range, xCell As Range
Dim xRows As Integer


xTitleId = "Merge Duplicates"

Set WorkRng = Application.Selection
Set WorkRng = Application.InputBox("Range", xTitleId, WorkRng.Address, Type:=8)

Application.ScreenUpdating = False
Application.DisplayAlerts = False

xRows = WorkRng.Rows.count

For Each Rng In WorkRng.Columns
    For i = 1 To xRows - 1
        For j = i + 1 To xRows
            If Rng.Cells(i, 1).Value <> Rng.Cells(j, 1).Value Then
                Exit For
            End If
        Next
        WorkRng.Parent.Range(Rng.Cells(i, 1), Rng.Cells(j - 1, 1)).Merge
        i = j - 1

    Next
Next

Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub

NB このモジュールをモジュールとして挿入し、シートに戻って実行し、入力ボックスが表示されたら必要なデータ範囲を選択し、OKで終了します。

— ラジェッシュS
ソース