検索、抽出して別の表を作りたい

質問

Ａ　　　ＢＣ　　　ＤＥ　　　ＦＧ　　　ＨＩ　　　ＪＫ　　　ＬＭ　
１　　　　　　青木　　井上　　上野　　江藤　　小川　　加藤
２　　１日　　　aa 　 　 aa 　 　　bb 　　　bb 　 　 　- 　 　 -
３　　２日 　泊cc　　出cc　　出cc　　出cc　　　aa　　出cc
４　　３日 　出cc　 　　dd　 　　dd　 　　dd　 　　dd　　　 dd
５　　・
・　　・
・　　・
・　　29日　　　ee　　出ff　　 出ff　　　　-　　　 ee　　　ee
31　30日　　出cc　　　 dd　　　dd　　　dd　　　dd　　泊cc
32　31日　　出gg　　出gg　　出cc　　　ee　　　- 　　出cc　　　　　
ローマ小文字は場所、出＝出張、泊＝宿泊を伴う出張を表していて
こういう表があるのですが、この表を元に別の表を作りたいのですが

・「出」または「泊」のある日にちを若い日付から順に表示させたい
＜表１＞
　青木　　　 井上　　　 上野　　　 江藤　　　 小川　　　 加藤
　 ２日cc　　 ２日cc　　２日cc　　２日cc　　　　　　　　　 ２日cc
　 ３日cc　　29日ff　　 29日ff　　　　　　　　　　　　　　　　30日cc
　30日cc　　31日gg　　31日cc　　　　　　　　　　　　　　　31日cc
　31日gg

＜表２＞（※出張は出＋泊の人数）

２日　cc出張＝計５人　宿泊＝１人　　
３日　cc出張＝計１人
29日　 ff出張＝計２人
30日　 cc出張＝計２人　宿泊＝1人　
31日　 cc出張＝計２人　
　　　 　gg出張＝計２人　

どなたかよろしくお願いいたします。

回答No.1

pc_knight · ベストアンサー

以下のVBAで・・
Sub test()
For s = 2 To 4
Sheets(s).Cells.ClearContents
Next s
Sheets(3).Range("A1").Value = "日": Sheets(3).Range("B1").Value = "人数"
Sheets(4).Activate
Range("A1").Value = "日": Range("B1").Value = "計"
For c1 = 2 To 256 Step 2
Sheets(2).Cells(1, c1 / 2).Value = Sheets(1).Cells(1, c1)
For r1 = 2 To 32
Cells(r1, 1).Value = Sheets(1).Cells(r1, 1)
kb = Sheets(1).Cells(r1, c1)
ekb = ""
If Left(kb, 1) = "泊" Then ba = Right(kb, Len(kb) - 1): ekb = ba & "宿"
If Left(kb, 1) = "出" Then ba = Right(kb, Len(kb) - 1): ekb = ba & "出"
If ekb <> "" Then
r2 = Sheets(2).Cells(65536, c1 / 2).End(xlUp).Row + 1
Sheets(2).Cells(r2, c1 / 2).Value = Sheets(1).Cells(r1, 1) & Right(kb, Len(kb) - 1)
For c2 = 3 To 254 Step 2
If Cells(1, c2) = ekb Or Cells(1, c2 + 1) = ekb Then
Exit For
End If
If Cells(1, c2 + 1) = "" Then
Cells(1, c2).Value = ba & "宿"
Cells(1, c2 + 1).Value = ba & "出"
Exit For
End If
Next c2
Cells(r1, c2 + 1).Value = Cells(r1, c2 + 1).Value + 1
Cells(r1, 2).FormulaR1C1 = "=SUM(R[0]C[1]:R[0]C[228])"
If Left(kb, 1) = "泊" Then
Cells(r1, c2).Value = Cells(r1, c2).Value + 1
End If
End If
Next r1
Next c1
Sheets(3).Activate
For r4 = 2 To 32
If Sheets(4).Cells(r4, 2) >= 1 Then
r3 = Range("A65536").End(xlUp).Row + 1
Cells(r3, 1).Value = Sheets(4).Cells(r4, 1)
For c4 = 4 To 256 Step 2
If Sheets(4).Cells(r4, c4) <> "" Then
If Sheets(4).Cells(r4, c4 - 1) <> "" Then
hk = "宿泊＝ " & Sheets(4).Cells(r4, c4 - 1) & "人"
Else
hk = ""
End If
If Cells(r3, 2) = "" Then
Cells(r3, 2).Value = Sheets(4).Cells(1, c4) & "＝計" & Sheets(4).Cells(r4, c4) & "人" & hk
Else
Cells(r3, 2).Value = Cells(r3, 2) & Chr(10) & Sheets(4).Cells(1, c4) & "＝計" & Sheets(4).Cells(r4, c4) & "人" & hk
End If
End If
Next c4
End If
Next r4
MsgBox "終了"
End Sub

参考URL：

http://www.serpress.co.jp/excel/vba001.html

お礼

ありがとうございます。
これはマクロというんでしょうか？
全く触れたことのない分野でまだちんぷんかんぷんですが
教えていただいたものを参考に勉強してみたいと思います。
ちゃんとできるかなぁ・・・
関数でできるのかな？と思っていたのですが
限界があるのですね。

このたびは本当にありがとうございました。

回答No.4

noname#52504

ご質問のような複雑な処理ではマクロを使うのが普通だと思いますが、
手順を踏んで順次処理すれば、関数を使って処理することも不可能というわけではありません。

以下、
「質問文の表がSheet1にある」
「B1セルとC1セルは結合されている」
「B3セルとC3セルにはそれぞれ「泊」と「cc」が入力されている」
ものとします。

●＜表１＞
　関数だけで処理することもできますが、とりあえずジャンプ機能と組み合わせた方法を例示します。
　以下、質問文の表の下方、41行目以降に作成するとします。

Step1.　41行目に見出し行をコピーする
　B41:C41　青木，D41:E41　井上　…

Step2.　B42とC42を結合して、下記の数式を入力する

　　=IF(B2<>"",$A2&" "&C2,0)

Step3.　B42:C42を、名前の数に応じて右方向にフィルする

Step4.　42行目の数式を、日付の数に応じて下方向にフィルする
　下記のような表ができるはずです。

　ＢＣ　　ＤＥ　　　ＦＧ　　　ＨＩ　　　ＪＫ　　ＬＭ
　青木　　井上　　　上野　　　江藤　　　小川　　加藤
　0　　　　0　　　　　0　　　　0　　　　0　　　　0
　２日 cc　２日 cc　　２日 cc　２日 cc　0　　　　２日 cc
　３日 cc　0　　　　　0　　　　0　　　　0　　　　0
　0　　　　29日 ff　　29日 ff　0　　　　0　　　　0
　30日 cc　0　　　　　0　　　　0　　　　0　　　　30日 cc
　31日 gg　31日 gg　　31日 cc　0　　　　0　　　　31日 cc

Step5.　ジャンプ機能で0が入ったセルを選択する
　上記表全体を選択して、
　編集＞ジャンプ＞セル選択＞数式を選択＞「数値」以外のチェックを外す＞ＯＫ

Step6.　選択したセルを削除して上方向にシフト
　下記のような表になるはずです。

　青木　　井上　　　上野　　江藤　　　小川　加藤
　２日 cc　２日 cc　２日 cc　２日 cc　　　 ２日 cc
　３日 cc　29日 ff　29日 ff　　　　　　　　30日 cc
　30日 cc　31日 gg　31日 cc　　　　　　　　31日 cc
　31日 gg

（Excel2003で動作確認済）

●＜表２＞
　作業列ならぬ「作業表」をいくつか作成する必要があります。
　以下、質問文の表の右方、O列に書き出すものとします。

Step1.　作業表１の作成
　出張・宿泊と伴うデータのみを整形して抽出します。
　別のシート(Sheet2とします）のB2，C2セルを結合して、下記の数式を入力、
　＜表１＞の場合と同様に右・下方向にフィル

　　=IF(Sheet1!B2<>"",Sheet1!B2&" "&Sheet1!C2,"")

　こんな表ができます。

　泊 cc　出 cc　出 cc　出 cc　　　　　　出 cc
　出 cc
　　　　 出 ff　出 ff
　出 cc　　　　　　　　　　　　　　　　 泊 cc
　出 gg　出 gg　出 cc　　　　　　　　　 出 cc

Step2.　場所の一覧を書き出す。
　Sheet2の1行目、作業表1の右方に、場所の一覧を書き出してください。
　（コレを関数でやるとなるとまた大変な処理になるので割愛します）
　以下 O1セルからU1セルにかけて、

　aa　bb　cc　dd　ee　ff　gg

　と入力されているものとします。

Step3.　作業表２の作成
　作業表１と、場所の一覧から、場所毎・日付別の宿泊者数をカウントします。
　Sheet2のO2セルに下記の数式を入力、右・下方向にフィル

　　=COUNTIF(Sheet2!$B2:$M2,"泊 "&O$1)

　aa　bb　cc　dd　ee　ff　gg

　　　　　1

　　　　　1

Step4.　作業表３の作成
　作業表１，２と、場所の一覧から、場所毎・日付別の出張者数をカウントします。
　Sheet2のW2セルに下記の数式を入力、右・下方向にフィル

　　=COUNTIF(Sheet2!$B2:$M2,"出 "&O$1)+O2

　　　　　5
　　　　　1
　　　　　　　　　　　2
　　　　　2
　　　　　2　　　　　　　2

Step5.　作業表４の作成
　作業表２，３から、表示する文字列を生成します。
　Sheet2のAE2セルに下記の数式を入力、右・下方向にフィル

　　=IF(W2,O$1&"出張＝計"&W2&"人 ","")&IF(O2,O$1&"宿泊＝"&O2&"人 ","")

　　　cc出張＝計5人 cc宿泊＝1人
　　　cc出張＝計1人
　　　　　　　　　　　　　　　　　　　　ff出張＝計2人
　　　cc出張＝計2人 cc宿泊＝1人
　　　cc出張＝計2人　　　　　　　　　　　　　　　　　　　　　gg出張＝計2人

Step6.　＜表２＞の作成
　作業表４の結果を結合して、Sheet1に書き出します。
　Sheet1のO2セルに下記の数式を入力、右・下方向にフィル

　　=Sheet2!AE2&Sheet2!AF2&Sheet2!AG2&Sheet2!AH2&Sheet2!AI2&Sheet2!AJ2&Sheet2!AK2

　cc出張＝計5人 cc宿泊＝1人
　cc出張＝計1人
　ff出張＝計2人
　cc出張＝計2人 cc宿泊＝1人
　cc出張＝計2人 gg出張＝計2人

以上。

（Excel2003で動作確認済）

ここまでご覧になっていかがでしょうか？
「こんな複雑な処理が必要ならマクロの方がまだマシ」とお思いになったとしたら、
それが普通の判断です。
マクロを使うにはある程度のスキルが必要ですが、だからといって、マクロよりも関数の方が簡単というわけではありません。
もし私自身がこういった処理をする必要があったとして、関数でやろうとは思いません。

関数を使うにしろ、マクロを使うにしろ、一足飛びに全部自動化しようとせず、
作業全体を細かく切り分けて、個別の処理ごとに、ご自分のスキルに合わせて省力化を図っていくのが現実的ではないかと思います。

お礼

回答ありがとうございました。
関数でもできないことはないけれど・・・現実的ではない
というこのようですね。

それにしてもお時間がたっておりましたのに
回答ありがとうございました！！！
参考にさせていただきます！！

回答No.3

imogasi

＞関数でできるのかな？と思っていたのですが
関数は計数を足したり、件数をカウウトしたりは、まあまあできます。
しかし本質問のように、
　２次元の縦横にデータがある表で（１列のデータはやりやすい）
　該当が２件以上あり（関数は該当の２つめを捉え難い）
　該当データをセットする（持ってくる）場所が決まっている（結果　データを置く表の構成が指定されている）
ようなのは、むつかい。
ーー
単なる抜き出しでもエクセルの関数では難しい。
ーー
それでＶＢＡを使うことにならざるを得ない。
例エータＳｈｅｅｔ１（質問と同じ）
Ａ ＢＣ ＤＥ ＦＧ ＨＩ ＪＫ ＬＭ
-- 青木 井上 上野 江藤 小川 加藤
１日 aa aa bb bb - -
２日 泊cc 出cc 出cc 出cc aa 出cc
３日 出cc dd dd dd dd dd
・
・
・
29日 ee 出ff 出ff - ee ee
30日 出cc dd dd dd dd 泊cc
31日 出gg 出gg 出cc ee - 出cc
ーーー
ＶＢＡコード。
ＶＢＥ画面の標準モジュールに下記を張り付け、実行する。
コード行数短が少なくている、がそれだけに判っていただけるかな。
Sub test01()
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Set sh1 = Worksheets("Sheet1")
Set sh2 = Worksheets("Sheet2")
'---
ce = sh1.Range("IV2").End(xlToLeft).Column
MsgBox ce
For c = 2 To ce '第２列から右端列まで繰り返し（人ごと繰り返し）
sh2.Cells(1, (c - 1) * 2 + 1) = sh1.Cells(1, c)
sh2.Cells(2, (c - 1) * 2 + 1) = sh1.Cells(2, c)
k = 3
re = sh1.Cells(55536, c).End(xlUp).Row
For r = 1 To re '第1行から最下端行まで繰り返し (日ごと繰り返し)
' 「出」または「泊」のある日の場合
If Mid(sh1.Cells(r, c), 1, 1) = "出" Or Mid(sh1.Cells(r, c), 1, 1) = "泊" Then
sh2.Cells(k, (c - 1) * 2 + 1) = sh1.Cells(r, 1) '日をセット
sh2.Cells(k, (c - 1) * 2 + 2) = Mid(sh1.Cells(r, c), 2, 20) '場所セット
k = k + 1
End If
Next r '次行へ
Next c '次列へ
End Sub
ーーー
結果
Ｓｈｅｅｔ２に
ＢＣ ＤＥ ＦＧ ＨＩ ＪＫ ＬＭ
青木 井上 上野 江藤 小川 加藤
２日 cc ２日 cc ２日 cc ２日 cc ２日 cc
３日 cc 29日 ff 29日 ff 30日 cc
30日 cc 31日 gg 31日 cc 31日 cc
31日 gg
ＶＢＡコードが判っていただけるか判らないので、とりあえず、表１だけにします。

お礼

どうもありがとうございます。
がんばって少しずつ勉強してみたいと思います。

このたびはご丁寧に色々と教えてくださいありがとうございます！！

回答No.2

pc_knight

ANo1です。
＞全く触れたことのない分野でまだちんぷんかんぷんですが

すぐに利用するのに必要な必要最低限の補足説明をします。
（１）まず、No1. にて回答のSub test()の行からEnd Subの行までをコピーし、下記の「☆貼り付け方法」ではりつけを行います。（一度行うだけ）
（２）その後、表１，２を作成したいときは、下記の「☆実行方法」に記した方法の操作を行うと数秒（データ件数に比例）で表１，２の作成が完了します。
ただし、ワークシートは４シートあり、基データは、一番左のシートにインプットされていることが必要条件です。
ぜひ、ＶＢＡの速さを体験して見て下さい。

☆貼り付け方法
1)ALT+F11キーを押してVBE画面を開き
2)挿入(I)、標準モジュール(M)でモジュールを追加
3) 標準モジュール(M) Sub test()の行からEnd Subの行までをコピーして貼り付け、VBE画面を閉じる

☆実行方法
1)ツール(T)→マクロ(M) →マクロ(M) →”test”選択→実行
または
2)ALT+F8キーを押して→”test”選択→実行
または
3)シートにボタンを配置して、それにマクロを登録←これが一番便利です。
方法は、http://www.sanynet.ne.jp/~awa/excelvba/kouza/chapt_01/sec12_01.htmlを参照

このＶＢＡについてもう少し知るには、ＶＢＡ内の単語らしき所、例えば「If」のところにカーソルを合わせ「F1」キーを押すと「If」に関するヘルプ画面が表示され、解説や使用例がでます。それである程度は、何の処理か読めるかも知れません。

お礼

また詳しい説明をありがとうございました。
なんとお礼を申してよいのやら。

アドバイスを参考にやってみます。
ありがとうございました！