EXCLEのマクロ データの絞り込み

質問

下記のようなことは可能でしょうか。
ご教授いただけますと幸いです。

A列 B列 C列
あああ いいい 1234
あああ ううう 1235
あああ えええ 1236

のデータを

A列 D列
あああ 1234,1235,1236

の用にしたいのです。

A列が同じデータでB列が違う行をまとめて
1行にする。しかし、B列とC列は不要だが、D列に
C列にあった数値データを ,でセル内に合体させたい

回答No.5

ka_na_de · ベストアンサー

＃３です。

改良しました。

Sub test02()
　　Dim myLastRow As Long
　　Dim i As Long

　　Range("A1").CurrentRegion.Sort _
　　　　Key1:=Range("A1"), Order1:=xlAscending, _
　　　　Header:=xlGuess

　　myLastRow = Cells(Rows.Count, "A").End(xlUp).Row

　　For i = myLastRow To 2 Step -1
　　　　If Cells(i, "A").Value = Cells(i - 1, "A").Value Then
　　　　　　 Cells(i - 1, "C").Value = Cells(i - 1, "C").Value & _
　　　　　　　　　　　　　　　　　　 " , " & Cells(i, "C").Value
　　　　　　 Cells(i - 1, "D").Value = Cells(i - 1, "C").Value
　　　　　　 Rows(i).Delete
　　　　Else
　　　　　　Cells(i, "D").Value = Cells(i, "C").Value
　　　　End If
　　Next i

　　Columns("B:C").Clear
End Sub

お礼

ありがとうございます。
大変感謝しています。

ばっちりうまくいきました。

回答No.4

keithin

元のデータが並べ替え済みであるのかとか，そういった細かい実際の姿によって如何様にも効率が変わりそうですね。

とりあえず全然バラバラを想定して。
Sub macro1()
　Dim h As Range
　Dim i As Long
　Dim res As Long

　'結合
　For i = 1 To Range("A65536").End(xlUp).Row
　　res = Application.Match(Cells(i, "A"), Range("A:A"), 0)
　　Cells(res, "D") = Cells(res, "D") & "," & Cells(i, "C")
　Next i

　'清掃
　For Each h In Range("D:D").SpecialCells(xlCellTypeConstants)
　　h = Mid(h, 2, 999)
　Next

　'もし要るなら
　Range("1:1").Insert
　Range("D1") = "head"
　Range("D:D").AutoFilter field:=1, Criteria1:="="
　Range("D:D").EntireRow.Delete
　range("B:C").clearcontents
End Sub

お礼

回答ありがとうございます。
試してみたのですが、うまくいきませんでした。
私の説明が悪かったのかと思います。
結果はD列に数値データがまとまって表示されたのですが、
0表示とか4.90272700458249E+38という風に表示されてしまいました。

こちらの設定の問題でしょうか。

回答No.3

ka_na_de

こんばんは。

一例です。

Sub test01()
　　Dim myLastRow As Long
　　Dim i As Long

　　Range("A1").CurrentRegion.Sort _
　　　　Key1:=Range("A1"), Order1:=xlAscending, _
　　　　Header:=xlGuess

　　myLastRow = Cells(Rows.Count, "A").End(xlUp).Row

　　For i = myLastRow To 2 Step -1
　　　　If Cells(i, "A").Value = Cells(i - 1, "A").Value Then
　　　　　　 Cells(i - 1, "C").Value = Cells(i - 1, "C").Value & _
　　　　　　　　　　　　　　　　　　 " , " & Cells(i, "C").Value
　　　　　　 Cells(i - 1, "D").Value = Cells(i - 1, "C").Value
　　　　　　 Rows(i).Delete
　　　　End If
　　Next i

　　Columns("B:C").Clear
End Sub

補足

ありがとうございます。
早速、アドバイスいただいたマクロを実行したところほぼ出来たのですが、1点説明が悪かったのか、A列が複数無いデータはそのままC列にある数値データを残したかったのです。

結果
A列
同じデータがない場合はc列のデータはD列に移行したい

おかげさまで、いただいたマクロを実行したところA列に複数あるデータのC列の数値データは、D列に,区切りで合体できました。

可能でしょうか。

回答No.2

mt2008

誤記訂正！

誤：D2には　=C21
正：D2には　=C2

回答No.1

mt2008

あまりスマートではありませんが……。
添付の図を見てください。
最終的にオートフィルタを使いたいので1行目には適当に項目名を付けます。

D2には　=C21
D3に　=IF(COUNTIF(A$2:A2,A3)=0,C3,INDEX(D:D,SUMPRODUCT(MAX((A$2:A2=A3)*ROW(A$2:A2))))&","&C3)　と、入れて下方向にコピー
E2に　=(COUNTIF(A3:A$100,A2)=0)　と入れて下方向にコピー
＃データが100行以上ある場合はA100を書き換えてください。

あとはオートフィルタでE列が「TRUE」の物だけを表示し、A列を昇順で並び替えれば出来上がり

お礼

回答ありがとうございます。
試してみたのですが、うまくいかず申し訳ございません。
うまくいかないと言うよりは、C列の数値データをAが同じ場合には
一つのセルにまとめたかったのですが、うまくいかなかったのです。
やり方が悪かったのかもしれません。

他の方の回答で今回は試しみてます。