excelで表を作り変える方法を教えてください

質問

画像のように左側のようになっている表を、
右側のように作り変えたいのですが。。。

・タイトルが表上にしか入っていない
・同一列に同じ名前が複数入っている

のでmatchも使えずこまっています。

ちなみに表だけで100個以上あるので、
表の横にタイトルを入力していくだけでも一苦労です。。。
何かいい方法をご存じの方、いらっしゃいませんでしょうか？

回答No.3

tom04 · ベストアンサー

こんばんは！
元データの表の配置を工夫すれば関数でも対応できそうな感じですが、
お示しの画像の配置だと、やはりVBAの方がやり易いでしょうかね！

一例です。
↓の画像で左側がSheet1で元の表があり、Sheet2に表示するようにしてみました。
Alt+F11キー　→　メニュー　→　挿入　→　「標準モジュール」を選択　→　VBE画面に
↓のコードをコピー＆ペーストしてマクロを実行してみてください。
（Alt+F8キー　→　マクロ　→　マクロ実行です）

Sub Sample1() 'この行から
Dim i As Long, j As Long, k As Long, n As Long, cnt As Long
Dim wS1 As Worksheet, wS2 As Worksheet
Set wS1 = Worksheets("Sheet1") '←「Sheet1」は実際のSheet名に！
Set wS2 = Worksheets("Sheet2")

Application.ScreenUpdating = False
wS2.Cells.ClearContents
wS2.Cells(1, 1) = "名前"
cnt = 1
For i = 2 To wS1.Cells(Rows.Count, 2).End(xlUp).Row
If wS1.Cells(i, 2) <> "" Then
If wS1.Cells(i, 3) = "" Then
cnt = cnt + 1
wS2.Cells(1, cnt) = wS1.Cells(i, 2)
ElseIf IsNumeric(wS1.Cells(i, 3)) Then
With wS2.Cells(Rows.Count, 1).End(xlUp).Offset(1)
.Value = wS1.Cells(i, 2)
.Offset(, cnt - 1) = wS1.Cells(i, 4)
End With
End If
End If
Next i

'重複を1行に！
For k = wS2.Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1
If WorksheetFunction.CountIf(wS2.Columns(1), wS2.Cells(k, 1)) > 1 Then
n = WorksheetFunction.Match(wS2.Cells(k, 1), wS2.Columns(1), False)
j = wS2.Cells(k, Columns.Count).End(xlToLeft).Column
wS2.Cells(k, j).Cut wS2.Cells(n, j)
wS2.Rows(k).Delete
End If
Next k
wS2.Columns.AutoFit
Application.ScreenUpdating = True
End Sub 'この行まで

※　Sheet1のデータは画像のようにB2セル以降にあるとします。
※　1行・1列でも違った場合、滅茶苦茶な表示になってしまいます。m(_ _)m

お礼

無事できました!!
本当に困っていたのでとても助かりました。。。
ありがとうございます!!

回答No.7

KURUMITO

表のタイトルが多くなっても対応できる方法です。
元の表がシート１に有ってB２セルからD２セルの下方にそれぞれお示しのようなデータが入力されているとします。
作業列をF列とG列に作って対応します。
F２セルには次の式を入力して下方にドラッグコピーします。

=IF(B2="","",IF(COUNTIF(B2,"■*")=1,ROUNDDOWN(MAX(F$1:F1),-3)+1000,IF(B2="名前","",IF(COUNTIF(B$1:B1,B2)=0,MAX(F$1:F1)+1,ROUNDDOWN(MAX(F$1:F1),-3)+INDEX(G$1:G1,MATCH(B2,B$1:B1,0))))))

G２セルには次の式を入力して下方にドラッグコピーします。

=IF(OR(COUNTIF(B2,"■*")=1,B2="名前"),"",IF(COUNTIF(B$1:B2,B2)=1,MAX(G$1:G1)+1,""))

お求めの表をシート２に作るとしてシート２のA２セルには名前と入力します。
A３セルには次の式を入力して下方にドラッグコピーします。

=IF(ROW(A1)>MAX(Sheet1!G:G),"",INDEX(Sheet1!B:B,MATCH(ROW(A1),Sheet1!G:G,0)))

タイトルを表示するためB２セルには次の式を入力したのちに右横方向にドラッグコピーします。

=IF(COLUMN(A1)>INT(MAX(Sheet1!$F:$F)/1000),"",INDEX(Sheet1!$B:$B,MATCH(COLUMN(A1)*1000,Sheet1!$F:$F,0)))

最後にB３セルには次の式を入力して右横方向にドラッグコピーしたのちに下方にもドラッグコピーします。

=IF(ISERROR(INDEX(Sheet1!$D:$D,MATCH(COLUMN(A1)*1000+ROW(A1),Sheet1!$F:$F,0))),"",INDEX(Sheet1!$D:$D,MATCH(COLUMN(A1)*1000+ROW(A1),Sheet1!$F:$F,0)))

回答No.6

kagakusuki

今仮に、変換後の表をSheet2に作成し、Sheet2のA列は「名前」欄として使用し、Sheet2の2行目は「名前」や「■人望がある」、「■運動神経が良い」といった、各項目の表示欄として使用し、実際のデータはSheet2の3行目以下に表示するものとします。
　又、Sheet1の各表のC列の項目名は、必ず「ランキング」となっているものとします。
　又、Sheet3のA列とB列を作業列として使用するものとします。

　まず、Sheet3のA1セルに次の関数を入力して下さい。

=IF(INDEX(Sheet1!$C:$C,ROW()+1)="ランキング",ROW(),"")

　次に、Sheet3のB1セルに次の関数を入力して下さい。

=IF(AND(INDEX(Sheet1!$B:$B,ROW())<>"",COUNT($A$1:$A1),COUNTIF(Sheet1!$B$2:INDEX(Sheet1!$B:$B,ROW()),INDEX(Sheet1!$B:$B,ROW()))=1),IF(ROW()-MATCH(9E+99,$A$1:$A1)>1,ROW(),""),"")

　次に、Sheet3のA1～B1の範囲をコピーして、同じ列の2行目以下に貼り付けて下さい。

　次に、Sheet2のB2セルに次の関数を入力して下さい。

=IF(COLUMNS($B:B)>COUNT(Sheet3!$A:$A),"",INDEX(Sheet1!$B:$B,SMALL(Sheet3!$A:$A,COLUMNS($B:B))))

　次に、Sheet2のA3セルに次の関数を入力して下さい。

=IF(ROWS($3:3)>COUNT(Sheet3!$B:$B),"",INDEX(Sheet1!$B:$B,SMALL(Sheet3!$B:$B,ROWS($3:3))))

　次に、Sheet2のB3セルに次の関数を入力して下さい。

=IF(OR($A3="",B$2=""),"",IF(COUNTIF(INDEX(Sheet1!$B:$B,SMALL(Sheet3!$A:$A,COLUMNS($B:B))):INDEX(Sheet1!$B:$B,IF(COLUMNS($B:B)<COUNT(Sheet3!$A:$A),SMALL(Sheet3!$A:$A,COLUMNS($B:B)+1),MATCH(9E+307,Sheet1!$C:$C))),$A3),INDEX(Sheet1!$D:$D,MATCH($A3,INDEX(Sheet1!$B:$B,SMALL(Sheet3!$A:$A,COLUMNS($B:B))):INDEX(Sheet1!$B:$B,ROWS(B:B)),0)+SMALL(Sheet3!$A:$A,COLUMNS($B:B))-1),""))

　次に、Sheet2のB2～B3の範囲をコピーして、同じ行のB列よりも右側にあるセル範囲に貼り付けて下さい。
　次に、Sheet2の3行目全体をコピーして、Sheet2の3行目以下に貼り付けて下さい。

　これで、並べ替えられた表が、Sheet2に自動的に表示されます。

回答No.5

tsubuyuki

２番です。

マクロの使い方は自分で調べましょう・・と言いたいところですが、
マクロを提案してしまった手前、取り急ぎ使い方だけ。

Ａｌｔ＋Ｆ１１キーで、ＶＢＥを起動します。
画面左側にエクスプローラーのような部分があると思いますので
（無かったら、表示→プロジェクトエクスプローラー　で出てきます）
この中の「ＶＢＡＰｒｏｊｅｃｔ（該当のワークブックの名前）」を右クリックし、
挿入→標準モジュール　を選択すると、Ｍｏｄｕｌｅ１と言う名前のモジュールが出来ますので
２番のモノでも結構ですし、３番さんのコードでも結構ですので
（３番さんのコードの方が洗練されてるかな？と思いますが＾＾；）
コピーして、ＶＢＥ画面の右側に貼り付けましょう。

エクセルに戻り、Ａｌｔ＋Ｆ８キーを押すと、
マクロ一覧のダイアログが出てきますから、動かしたいコードの名前を選択し、
「実行」ボタンを押してやります。

これが、基本です。

詳細（どんな処理をしているのかなどなど）はご自身で紐解いていくとよろしいかと思いますよ。
多分、無駄にはなりませんから。

回答No.4

MackyNo1

例えば以下のような数式をＩ２セルに入力し右方向にオートフィルすれば100個のタイトルを表示できます。

=INDEX($B:$B,SMALL(INDEX((($C$2:$C$1000<>"")+($B$2:$B$1000=""))*10000+ROW($C$2:$C$1000),),COLUMN(A1)))&""

Ｈ２セルには以下の式を入力して下方向にオートフィルします。

=INDEX($B:$B,SMALL(INDEX((($C$2:$C$1000="")+($B$2:$B$1000="名前"))*10000+ROW($C$2:$C$1000),),ROW(A1)))&""

この操作で重複のある名前が抽出されますので、そのまま右クリック「コピー」もう一度右クリック「形式を選択して貼り付け」で「値」を選択してＯＫします。
最後にデータタブの「重複の削除」で名前の重複をなくします。

次にＤ列のデータを表に入れ込むことになりますが、実際の100個の表のデータは例示のデータのように1つの表に名前が4件程度で（次の表データまでに8行程度の間隔がある）、Ｂ列にすべて入力されているのでしょうか？

その場合は、一覧表のＩ２セルに以下の式を入力し右方向および下方向にオートフィルします。

=IFERROR(INDEX($D:$D,MATCH($H3,INDEX($B:$B,MATCH(I$2,$B:$B,0)):INDEX($B:$B,MATCH(I$2,$B:$B,0)+9),)+MATCH(I$2,$B:$B,0)-1),"")

回答No.2

tsubuyuki

マクロはいけますか＾＾；
ざっくり適当ですいませんが

Sub Test()
Dim i As Long
Dim TagRow As Long, TagCol As Long, TagName As Range
Dim LastRow As Long

　　　　Range("H1").Select
　　　　LastRow = Cells(Rows.Count, 2).End(xlUp).Row
　　　　Range(Columns("H"), Selection.End(xlToRight)).Delete
　　　　Range("H2").Value = "名前"

　　　　TagCol = 8

　　　　For i = 2 To LastRow
　　　　　　　　If Range("B" & i).Value <> "名前" Then
　　　　　　　　　　　　If Range("B" & i).Value Like "■*" Then
　　　　　　　　　　　　　　　　TagCol = TagCol + 1
　　　　　　　　　　　　　　　　Cells(2, TagCol).Value = Range("B" & i).Value
　　　　　　　　　　　　Else
　　　　　　　　　　　　　　　　Set TagName = Columns("H").Find(What:=Range("B" & i).Value, LookAt:=xlWhole)
　　　　　　　　　　　　　　　　If TagName Is Nothing Then
　　　　　　　　　　　　　　　　　　　　With Cells(Rows.Count, 8).End(xlUp).Offset(1, 0)
　　　　　　　　　　　　　　　　　　　　　　　　.Value = Range("B" & i).Value
　　　　　　　　　　　　　　　　　　　　　　　　TagRow = .Row
　　　　　　　　　　　　　　　　　　　　End With
　　　　　　　　　　　　　　　　Else
　　　　　　　　　　　　　　　　　　　　TagRow = TagName.Row
　　　　　　　　　　　　　　　　End If
　　　　　　　　　　　　　　　　Cells(TagRow, TagCol).Value = Range("D" & i).Value
　　　　　　　　　　　　End If
　　　　　　　　End If
　　　　Next

End Sub

質問文で添付された図のように、
・各表が縦にズラッと並んでいること
・「名前」はＢ列に有ること
・各表のタイトルの頭に「■」がついていること、
・「ポイント？％？」がＤ列に有ること
・同一表の中に「名前」の重複が無いこと
が条件で、Ｈ列以降（右）に集計表が出来ます。

かなりザックリで、精査も洗練もしておりませんので、
お望みどおりにはいかないかもしれませんが＾＾；

お礼

丁寧にありがとうございます!!
マクロは触れたことがないのでどこに入力したらいいのかが分かりません。
教えていただけたら本当にありがたいです。申し訳ありません(>_<)

回答No.1

iw_steel

形式を選択して貼り付け貼り付けの
下の方に　行列を入れ替えるがありますが。

お礼

ありがとうございます。
ただ今回は抽出の作業を使うので単純に行列の入れ替えは使えないのです。。。