システムメンテナンスのお知らせ

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

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

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

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

「excelで表を作り変える方法を教えてく」の質問画像
gooドクター

A 回答 (7件)

こんばんは!


元データの表の配置を工夫すれば関数でも対応できそうな感じですが、
お示しの画像の配置だと、やはり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
「excelで表を作り変える方法を教えてく」の回答画像3
    • good
    • 0
この回答へのお礼

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

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

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


元の表がシート1に有ってB2セルからD2セルの下方にそれぞれお示しのようなデータが入力されているとします。
作業列をF列とG列に作って対応します。
F2セルには次の式を入力して下方にドラッグコピーします。

=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))))))

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

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

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

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

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

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

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

=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)))
    • good
    • 0

 今仮に、変換後の表を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に自動的に表示されます。
「excelで表を作り変える方法を教えてく」の回答画像6
    • good
    • 0

2番です。



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


Alt+F11キーで、VBEを起動します。
画面左側にエクスプローラーのような部分があると思いますので
(無かったら、表示→プロジェクトエクスプローラー で出てきます)
この中の「VBAProject(該当のワークブックの名前)」を右クリックし、
挿入→標準モジュール を選択すると、Module1と言う名前のモジュールが出来ますので
2番のモノでも結構ですし、3番さんのコードでも結構ですので
(3番さんのコードの方が洗練されてるかな?と思いますが^^;)
コピーして、VBE画面の右側に貼り付けましょう。

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

これが、基本です。


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

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



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

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

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

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

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

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

=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),"")
    • good
    • 0

マクロはいけますか^^;


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

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



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

かなりザックリで、精査も洗練もしておりませんので、
お望みどおりにはいかないかもしれませんが^^;
    • good
    • 0
この回答へのお礼

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

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

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


下の方に 行列を入れ替えるがありますが。
    • good
    • 0
この回答へのお礼

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

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

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


このカテゴリの人気Q&Aランキング