12万作品が月額500円(税別)で見放題なのはdTVだけ!! >>dTV(外部リンク)

よろしくお願いいたします
行数の異なるデータを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


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

A 回答 (6件)

こんにちは



横からですが、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
    • good
    • 1

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
    • good
    • 1

添付図参照


E1: =IFERROR(INDEX($B$1:$B$15,SMALL(IF($A$1:$A$15=$D1,ROW(A$1:A$15),""),COLUMN(A1))),"")
【お断り】上式は必ず配列数式として入力のこと
「EXCEL 複数行のデータを1行にまとめ」の回答画像4
    • good
    • 3

多分、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は単なる例で、実際は違う値であればできません)
    • good
    • 1

こんにちは!



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
    • good
    • 1
この回答へのお礼

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

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

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

マクロ(VBA)を使っても良いですか?


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

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人はこんなQ&Aも見ています


このQ&Aを見た人がよく見るQ&A

人気Q&Aランキング