エクセル2013で表の組み替え

質問

エクセル2013で表の組み替え
エクセル2013で表の組み替えのしかたを教えてください。
勤務表のイメージです。
下の例で、A2からA7までは担当者名（実際はもっと多く）、B1からF1までは日付（架空の例として5日まで）、B2からF7までに担当箇所（実際はもっと多く）がはいります。
1つの担当箇所に2人以上がはいることもあり得ます（見習、応援など）。

この上の表を、下の表のようにかんたんに組み替えたいのです。
下の表では、A2からA11までは担当箇所（2人以上はいることもあるので同一担当箇所の行が2行以上にふえることもあり得ます）、B1からF1までは日付、B2からF11まで担当者名です。

このような組み替えは、関数でやるのでしょうか、それともVBAでしょうか？
それとも（使った事はなくて勉強しなければなりませんが）データベースソフトのアクセスで処理すべき事でしょうか？
手作業でコピーするのが大変なのでどうか教えてくださいませ。

回答No.1

bunjii · ベストアンサー

>このような組み替えは、関数でやるのでしょうか、それともVBAでしょうか？
関数でできますがかなり面倒な論理を考えないと上手くいきません。
上の表をSheet1として、下の表をSheet2とした時に次のような数式で処理できます。
Sheet2!B2=IFERROR(INDEX(Sheet1!$A$2:$A$7,SUMPRODUCT(SMALL((Sheet1!B$2:B$7<>INDEX($A1:$A2,SUMPRODUCT(($A1:$A2<>"")*ROW(B$1:B$2))))*1000+ROW(B$1:B$6),MOD(ROW(),2)+1),1)),"")
オートフィルで右と下へコピーします。
貼付画像は提示されたデータのみを対象にしています。
元データの大きさに合わせて表を作り直す必要があります。

>1つの担当箇所に2人以上がはいることもあり得ます（見習、応援など）。
状況に応じてSheet2の配列を変更し、数式も変更することが必要かと思います。

お礼

ありがとうございました。たしかに動作確認し、おもわず顔がほころんでしまいました。シート2のA列の文字列でいろいろ変更できるのですね。質問して良かったです。使わせていただきます。

なやましい選択でしたが、最初に答えをいただいたbunjiiさまをベストアンサーとさせていただきます。

回答No.3

MarcoRossiItaly

今回の課題はちょっと、簡単に、とはいかないので、VBA が相場かもしれません。ベストアンサーは辞退します。

ただ今後のことを考えるなら、できれば、オートフィルタやピボットテーブルで扱いやすい構造の元データを作っておくことが望まれます。添付図のような表です。

そのような元データを作っておくと、一発では質問文のような表を作ることはできないかもしれませんが、オートフィルタやピボットテーブルと、比較的簡単な数式の組み合わせにより、作ることは可能です。

以下は、添付図のデータからピボットテーブルで抽出した例です。

合計 / ID　日付
場所　　2014/1/1　　2014/1/2　　2014/1/3　　2014/1/4　　2014/1/5　　総計
西館　　17　　　　　27　　　　　24　　　　　 5　　　　　22　　　　　 95
東館　　27　　　　　24　　　　　 9　　　　　27　　　　　 2　　　　　 89
南館　　 2　　　　 　9　　　　　17　　　　　31　　　　　17　　　　　 76
北館　　 5　　　　　17　　　　　 5　　　　　 2　　　　　36　　　　　 65
本館　　31　　　　　 5　　　　　27　　　　　17　　　　　 5　　　　　 85
総計　　82　　　　　82　　　　　82　　　　　82　　　　　82　　　　　410

回答No.2

tom04

こんばんは！
VBAでの一例です。

Sheet1のデータをSheet2に表示するようにしてみました。
尚、Sheet3を作業用のSheetとして使用していますので、
Sheet3は使っていない状態にしておいてください。
画面通り　東～本館の5種類としています。

Alt＋F11キー　→　メニュー　→　挿入　→　標準モジュール　→　VBE画面のカーソルが点滅しているところに
↓のコードをコピー＆ペースト　→　Excel画面に戻りマクロを実行してみてください。
（Alt＋F8キー　→　マクロ　→　マクロ実行です）

Sub Sample1() 'この行から
Dim i As Long, j As Long, k As Long, lastRow As Long
Dim wS2 As Worksheet, wS3 As Worksheet, myArry
Set wS2 = Worksheets("Sheet2")
Set wS3 = Worksheets("Sheet3")
myArry = Array("東館", "西館", "南館", "北館", "本館")
Application.ScreenUpdating = False
wS2.Cells.Clear
With Worksheets("Sheet1")
.Rows(1).Copy wS2.Range("A1")
For k = 0 To UBound(myArry)
wS3.Range("A2") = myArry(k)
For i = 2 To .Cells(Rows.Count, "A").End(xlUp).Row
For j = 2 To .Cells(1, Columns.Count).End(xlToLeft).Column
If .Cells(i, j) = myArry(k) Then
wS3.Cells(Rows.Count, j).End(xlUp).Offset(1) = .Cells(i, "A")
End If
Next j
Next i
lastRow = wS2.UsedRange.Rows.Count
wS3.Range("A2").CurrentRegion.Cut wS2.Cells(lastRow + 1, "A")
Next k
wS2.Columns.AutoFit
wS2.Range("A1").CurrentRegion.Borders.LineStyle = xlContinuous
End With
Application.ScreenUpdating = True
End Sub 'この行まで

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

お礼

ありがとうございました。たしかに動作確認し、おもわず顔がほころんでしまいました。質問して良かったです。配列の中身など、これからいろいろ試みてみます。いろいろ重宝しそうです。使わせていただきます。