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

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

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

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

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

No.3 ベストアンサー 回答者： tom04 回答日時： 2012/12/29 00:16

こんばんは！

元データの表の配置を工夫すれば関数でも対応できそうな感じですが、
お示しの画像の配置だと、やはり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

この回答へのお礼

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

お礼日時：2012/12/31 19:04

No.7 回答者： KURUMITO 回答日時： 2012/12/29 10:12

表のタイトルが多くなっても対応できる方法です。

元の表がシート１に有って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 回答日時： 2012/12/29 04:14

　今仮に、変換後の表を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 回答日時： 2012/12/29 00:55

２番です。

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


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

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

これが、基本です。


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

No.4 回答者： MackyNo1 回答日時： 2012/12/29 00:29

例えば以下のような数式をＩ２セルに入力し右方向にオートフィルすれば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 回答日時： 2012/12/28 17:10

マクロはいけますか＾＾；

ざっくり適当ですいませんが

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



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

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

この回答へのお礼

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

お礼日時：2012/12/28 18:16

No.1 回答者： iw_steel 回答日時： 2012/12/28 16:55

形式を選択して貼り付け貼り付けの

下の方に　行列を入れ替えるがありますが。

この回答へのお礼

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

お礼日時：2012/12/28 19:52