EXCEL 複数行のデータを1行にまとめる方法

よろしくお願いいたします
行数の異なるデータを1行にまとめる方法をご教授ください

下記の様なデータをもらいました
A1　X1
A1　X2
A1　X3
B1　X2
B1　X4
C1　X1
D1　X5
D1　X6
E1　X2
E1　X4
E1　X5
E1　X6
・

下記の様に変換したいです
A1　X1　X2　X3
B1　X2　X4
C1　X1
D1　X5　X6
E1　X2　X4　X5　X6
・

元データの桁数がコピーだけでは相当時間がかかりそうで。。
お知恵を頂けますと幸いです。

No.6 回答者： fujillin 回答日時：2017/11/24 16:06

こんにちは

横からですが、VBAでの別方法の一例です。

データが重複している場合は、結果的に無視してよいものと解釈しました。
途中に空白セルが混在しているなどについては想定していません。
（チェックしてスキップすればよいだけですが…）

データのあるシート名と結果を表示するシート名を正しく修正しておいてください。
（現状はSheet1、Sheet2にしてあります。）

Sub Sample()
Dim sh1 As Worksheet, sh2 As Worksheet
Dim dicR As Object, dicC As Object
Dim rw As Long, maxR As Long
Dim v1, v2

Set sh1 = Worksheets("Sheet1") '←元データのあるシート
Set sh2 = Worksheets("Sheet2") '←結果を表示するシート

Set dicR = CreateObject("Scripting.Dictionary")
Set dicC = CreateObject("Scripting.Dictionary")
maxR = sh1.Cells(Rows.Count, 1).End(xlUp).Row
sh2.Cells.Clear

For rw = 1 To maxR
　v1 = sh1.Cells(rw, 1).Value
　If Not dicR.exists(v1) Then
　　dicR.Add v1, dicR.Count + 1
　　sh2.Cells(dicR(v1), 1).Value = v1
　End If
　v2 = sh1.Cells(rw, 2).Value
　If Not dicC.exists(v2) Then dicC.Add v2, dicC.Count + 2
　sh2.Cells(dicR(v1), dicC(v2)).Value = v2
Next rw

Set dicR = Nothing
Set dicC = Nothing
End Sub

No.5 回答者： tom04 回答日時：2017/11/24 14:42

No.2です。

＞実施してみたところ課題があり・・・

今回はSheet3を作業用として使用するようにしていますので、
操作するブックにはSheet3を使っていない状態にしておいてください。

Sub Sample2()
Dim i As Long, lastRow As Long
Dim c As Range, r As Range
Dim wS2 As Worksheet, wS3 As Worksheet
Set wS2 = Worksheets("Sheet2")
Set wS3 = Worksheets("Sheet3")
wS2.Cells.ClearContents
Application.ScreenUpdating = False
With Worksheets("Sheet1")
.Range("A:A").AdvancedFilter Action:=xlFilterCopy, copytorange:=wS2.Range("A1"), unique:=True
.Range("B:B").AdvancedFilter Action:=xlFilterCopy, copytorange:=wS3.Range("A1"), unique:=True
wS3.Range("A1").Sort key1:=wS3.Range("A1"), order1:=xlAscending, Header:=xlYes
lastRow = wS3.Cells(Rows.Count, "A").End(xlUp).Row
Range(wS3.Cells(2, "A"), wS3.Cells(lastRow, "A")).Copy
wS2.Range("B1").PasteSpecial Paste:=xlPasteValues, Transpose:=True
For i = 2 To .Cells(Rows.Count, "A").End(xlUp).Row
Set c = wS2.Range("A:A").Find(what:=.Cells(i, "A"), LookIn:=xlValues, lookat:=xlWhole)
Set r = wS2.Rows(1).Find(what:=.Cells(i, "B"), LookIn:=xlValues, lookat:=xlWhole)
wS2.Cells(c.Row, r.Column) = wS2.Cells(1, r.Column)
Next i
End With
wS3.Cells.Clear
wS2.Rows(1).Delete
wS2.Activate
wS2.Range("A1").Select
Application.ScreenUpdating = True
MsgBox "完了"
End Sub

今度はどうでしょうか？m(_ _)m

No.4 回答者： mike_g 回答日時：2017/11/24 12:39

添付図参照

E1: =IFERROR(INDEX($B$1:$B$15,SMALL(IF($A$1:$A$15=$D1,ROW(A$1:A$15),""),COLUMN(A1))),"")
【お断り】上式は必ず配列数式として入力のこと

No.3 回答者： tatsu99 回答日時：2017/11/24 12:26

多分、No2の方から回答の再提示があると思いますので、いまのところ回答するつもりはありませんが、

>実施してみたところ課題があり
>A1　X1　X2　X3
>B1　空　X2　空　X4
>C1　X1
>D1　空　空　空　空　X5　X6
>E1　空　X2　空　X4　X5　X6
>というようにする必要があることが分かりました。
>ここは、関数で何とかなりそうです

変更前のB列の実際の値は、X1,X2,・・・X999のようにXと数字だけなのですか。
それであれば、マクロで、最初からそのようにすることは可能です。（X1,X2は単なる例で、実際は違う値であればできません）

No.2 回答者： tom04 回答日時：2017/11/24 11:33

こんにちは！

VBAになりますが、一例です。
元データはSheet1にあり、Sheet2に表示するとします。
尚、Sheet1の1行目は項目行になっていて、2行目以降にデータがあるとします。

標準モジュールにしてください。

Sub Sample1()
Dim i As Long, lastRow As Long, wS As Worksheet
Set wS = Worksheets("Sheet2")
Application.ScreenUpdating = False
wS.Cells.ClearContents
With Worksheets("Sheet1")
lastRow = .Cells(Rows.Count, "A").End(xlUp).Row
.Range("A:A").AdvancedFilter Action:=xlFilterCopy, copytorange:=wS.Range("A1"), unique:=True
For i = 2 To wS.Cells(Rows.Count, "A").End(xlUp).Row
.Range("A1").AutoFilter field:=1, Criteria1:=wS.Cells(i, "A")
Range(.Cells(2, "B"), .Cells(lastRow, "B")).SpecialCells(xlCellTypeVisible).Copy
wS.Cells(i, "B").PasteSpecial Paste:=xlPasteValues, Transpose:=True
Next i
.AutoFilterMode = False
End With
wS.Activate
wS.Range("A1").Select
Application.ScreenUpdating = True
MsgBox "完了"
End Sub

こんな感じではどうでしょうか？m(_ _)m

この回答へのお礼

早速ありがとうございます！
頂いたVBAを実施してみたところ無事並び替えができました。

実施してみたところ課題があり
A1　X1　X2　X3
B1　空　X2　空　X4
C1　X1
D1　空　空　空　空　X5　X6
E1　空　X2　空　X4　X5　X6
というようにする必要があることが分かりました。
ここは、関数で何とかなりそうです

お礼日時：2017/11/24 11:57

No.1 回答者： GooUserラック 回答日時：2017/11/24 11:30

マクロ（ＶＢＡ）を使っても良いですか？

元の左の列はソートされていると思って良いのでしょうか？