Excel 複数あるシートのデータを1枚にまとめる

何度かこちらで質問をさせていただいてます。
同じような質問を繰り返してしまい、申し訳ございませんがどうかお助け願いたいです。

複数あるシートを、1シートにまとめ、且つ見やすくしろと上司に言われました。
同一ブック内に７０シートあります。
いずれも列Aは空白のままで、列Bからデータが入力されています。
列Bにシステム名・そのシステムのバージョン・名前・その人の個人IDが、
列Cには人数が書かれています。
（画像参照）

▲▲▲
2.0.1
山田
ABCDE
佐藤
ACEDF
2.1.1
永田
DEFCD
・
・
・
●●●
1.0.1
渋谷
UUIOP
1.0.2
・
・
・

という感じです。
こんなデータが約７０のシートにそれぞれあります。
どのように1枚にまとめたいかといいますと、
１行目に名前・ID・機材名とバージョンずらずらずら
２行目から個人名・その人のID・1行目に書いている機材を使用しているか（使用していたら○をつけたい）
という感じです。

Excel初心者で、キャパ越えで困っています。
縦列につらつらつら～っと書かれているせいで、どうこれを行に移して名前とIDと機材名を関連つけるか悩んでいます。

どうか力を貸してください・・・
宜しくお願いいたします。

（なお、画像に使ったデータは参照用ですので、元データではありませんが、元データはこのような形です。）

No.4 回答者： matsu_jun 回答日時： 2011/10/20 23:40

buri16さん、こんばんは

前回同様の処理を行ってください。

Sub TabMake()
　Dim NewSH, TgtSH As Worksheet
　Dim RowEP, ColEP, RowWP, ColWP, RowRP As Long
　Dim RPhase As Integer '1:System 2:Ver 3:Name,ID
　Dim RName(4) As String
　Dim RParam(4, 2) As Integer
　Dim TempF As Boolean
　Set NewSH = Sheets.Add(Before:=Sheets(1))
　NewSH.Cells(2, 1).Value = "名前"
　NewSH.Cells(2, 2).Value = "ID"
　RowEP = 3
　ColEP = 3
　For Each TgtSH In Worksheets
　　If TgtSH.Name = NewSH.Name Then GoTo NO_OP
　　RowRP = 1
　　RPhase = 1
　　Do While (TgtSH.Cells(RowRP, 2) <> "")
　　　RName(RPhase) = TgtSH.Cells(RowRP, 2)
　　　RParam(RPhase, 1) = TgtSH.Cells(RowRP, 3)
　　　RParam(RPhase, 2) = RParam(RPhase, 2) + TgtSH.Cells(RowRP, 3)
　　　If RPhase < 4 Then
　　　　For i# = RPhase + 1 To 4
　　　　　RParam(i, 2) = 0
　　　　Next i
　　　　If RParam(RPhase, 1) <> 0 Then RPhase = RPhase + 1
　　　Else
　　　　With NewSH
　　　　　TempF = False
　　　　　Set c = Range(.Cells(3, 1), .Cells(RowEP, 1)).Find(RName(3))
　　　　　If Not c Is Nothing Then
　　　　　　If .Cells(c.Row, 2) = RName(4) Then
　　　　　　　TempF = True
　　　　　　Else
　　　　　　　i = c.Row
　　　　　　　Set c = Range(.Cells(3, 1), .Cells(RowEP, 1)).FindNext
　　　　　　　Do Until (i = c.Row)
　　　　　　　　If .Cells(c.Row, 2) = RName(4) Then
　　　　　　　　　TempF = True
　　　　　　　　　Exit Do
　　　　　　　　End If
　　　　　　　　Set c = Range(.Cells(3, 1), .Cells(RowEP, 1)).FindNext
　　　　　　　Loop
　　　　　　End If
　　　　　End If
　　　　　If TempF = True Then
　　　　　　RowWP = c.Row
　　　　　Else
　　　　　　RowWP = RowEP
　　　　　　.Cells(RowWP, 1) = RName(3)
　　　　　　.Cells(RowWP, 2) = RName(4)
　　　　　　RowEP = RowEP + 1
　　　　　End If
　　　　　Set c = Range(.Cells(1, 3), .Cells(1, ColEP)).Find(RName(1))
　　　　　If c Is Nothing Then
　　　　　　.Cells(1, ColEP) = RName(1)
　　　　　　.Cells(2, ColEP) = RName(2)
　　　　　　ColWP = ColEP
　　　　　　ColEP = ColEP + 1
　　　　　ElseIf .Cells(2, c.Column) = RName(2) Then
　　　　　　ColWP = c.Column
　　　　　Else
　　　　　　i = 1
　　　　　　Do While (1)
　　　　　　　ColWP = c.Column + i
　　　　　　　If .Cells(1, ColWP) = "" And .Cells(2, ColWP) = RName(2) Then
　　　　　　　　Exit Do
　　　　　　　ElseIf .Cells(2, ColWP) = "" Then
　　　　　　　　.Cells(2, ColWP) = RName(2)
　　　　　　　　ColEP = ColEP + 1
　　　　　　　　Exit Do
　　　　　　　ElseIf .Cells(1, ColWP) <> RName(1) Then
　　　　　　　　.Columns(ColWP).Insert
　　　　　　　　.Cells(2, ColWP) = RName(2)
　　　　　　　　ColEP = ColEP + 1
　　　　　　　　Exit Do
　　　　　　　End If
　　　　　　　i = i + 1
　　　　　　Loop
　　　　　End If
　　　　　.Cells(RowWP, ColWP) = .Cells(RowWP, ColWP) + RParam(4, 1)
　　　　End With
　　　　RPhase = IIf(RParam(4, 2) = RParam(3, 1), _
　　　　　IIf(RParam(3, 2) = RParam(2, 1), _
　　　　　IIf(RParam(2, 2) = RParam(1, 1), 1, 2), 3), 4)
　　　End If
　　　RowRP = RowRP + 1
　　Loop
NO_OP:
　Next TgtSH
　MsgBox "終了しました"
End Sub

これで上手くいくかどうか、試してください。データの並べ替えや表の整形はご自身でお願いします。
乗りかかった船ですので、仕様上これ以上不可能と判断されるまでお手伝いするつもりです。ただし、回答の文字数に制限があるため、機能の大幅な追加は受けかねます。

さて、buri16様は新入社員とのこと、お仕事御疲れ様です。
今回の質問でburi16様が社会人として真に学ぶべきは、仕事のお願いのし方です。私の目から見た、今回の大きなミスは下の3点です。

1) 現在に至るまでの経緯の提示が無い(前回の質問のリンクを貼っていない)
今回の質問文中に「何度かこちらで・・・」と記載がありますが、その質問のアドレスを記載しておくことで、それまでの経緯を他の回答者が参照することができたはずです。(私は検索して http://oshiete.goo.ne.jp/qa/7071258.html を見つけ、参照しました)

2) 仕様の提示が曖昧すぎる。
プログラムの経験が無くても、システム名、バージョン名、名前、IDが同じ列に記載されているのなら、どの行が何に相当するのか見分ける基準が無くては処理ができないのは分かるはずです。今回は、「C列に数字が・・・」という表現と添付した画像から推測し、こちら側で基準を見つけましたが、事前に提示があれば良かったです。また、「システム名」と「機材名」と文中に2つの用語が存在し、混乱の原因となっています。
更に、通常「ID」というのは、個体識別(Identification)のことですので、通常個人に対して一つしか付かない物です。そこに関する記述が全く無く、画像からも、IDを複数持つことが想定できないため、私の工数が倍になったのは間違いの無いことです。(ちなみに今回IDが複数ということで、上記プログラムは「同姓同名」の人の判別ができなくなりました。)

3) 後出しの条件が多すぎる上、適切な補足ができていない
今回色々な回答者の方の「○○ですか？」という投げかけは、解決の方法を探るものでした。それに対しbure16様の返信は、「そうとは限りません」の連続でした。すなわち「それは解決の方法にはなりません」と回答したに留まっていたのです。特に惜しかったのが、インデント調整に言及したところです。ここで、それぞれのインデント量まで正確に返答できていればもっと要領の良い解決策があったかもしれません。

丁寧な口調を用いれば気持ちよく仕事を引き受けてもらえるのは学生のうちまでです。これから先、社内・社外関わらず仕事をお願いすることが出てくるはずですが、その時今回と同じようなスタンスで臨めば、必ず貴方にも会社にも損害を与えます(場合によっては二度と貴方の依頼を受けてくれなくなるかもしれません)。

今回回答の文字数制限のため、柔らかい・婉曲な表現を利用できず、厳しい表現となっております。マクロも文字数制限のため、後から見返して非常に分かりにくく、エラー処理さえ省ききっており、非常に不本意なものとなっています。上のマクロがうまく動作すれば回答もこれで最後になりますので、最後に一言。今回の質問を糧に、社会人として成長なさること、期待しております。

No.3 回答者： matsu_jun 回答日時： 2011/10/18 17:59

buri16さん、こんばんは

当方、貴方の提示した情報のどれが真かが判断つきかねますので、最低これだけの条件は真であると仮定します。
前提1) C列の「人数」は正確である。(システム名、バージョン名の右側の数字が合っていればOK、下記のマクロは名前および個人コード右側の数字は関知しない)
前提2) C列の「人数」は半角数字であり、その他文字は入っていない。入っていたら恐らくエラーを発生します。もし覚え書き程度の記載があれば、それは削除してください。
前提3) 各シート 1行目から必ずデータが始まる。1行目に、一般的な表でよくあるところの表題など余計なものがあれば、事前に削除してください。
前提4) 当然の事ながら、データが終了した行より下にも余計なデータが存在してはいけない。余計なデータがあれば、事前に削除してください。
前提5) 記入されたデータに空行があると、そこで検索を終了します。空行があれば上詰めしてください。
前提6) 本情報以外の情報が記載されたシートは存在しない。ただしまったく空白のシートはあってもOK。余計なシートは事前に削除してください。
前提7) 一人の人物に対し、複数の個人IDを持つことは絶対に無い

また、以下の事項については考慮してあります
考慮1) 同一シートあるいは別のシートに同一人物が登場する場合（同じ人が複数のシステムを持つ場合）は、複数行に記載せず、同じ行に記載しています。
考慮2) システム1のバージョンAとシステム2のバージョンAは、別のものとして理解します。システム毎にバージョン名がカブっても構いません。
考慮3) 同一人物が、同一システムの同一バージョンを複数持つことを考慮しています。結果シートにおいて、通常はburi16さんが指定した「○」を使わず「1」で表示していますが、ここが「2」以上になっているときは、どこかでその数分だけ重複して登場していることを示します。

マクロの記載の仕方から、今回の処理の実行の仕方まで、下記に分かりやすく書いておきます。

1) 念のため、現在のファイルをコピーして、そのファイルで操作してください
2) Excelでファイルを開く（他のブックは全て閉じておく）
3) Alt + F11 キーを同時に押して、Microsoft Visual Basic Editor を開く
4) 左側のウィンドウで「ThisWorkbook」を探し、ダブルクリックする
5) 右側の空白部分に、以下をコピーして貼り付ける

'--------------------(ここからコピー)-----------------------
Sub TabMake()
　Dim NewSH, TgtSH As Worksheet
　Dim RowEP, ColEP, RowWP, ColWP As Long
　Dim RPhase As Integer '1:System 2:Ver 3:Name,ID
　Dim SysStr, VerStr As String
　Dim SysNum, VerNum, VerSum, NamCnt As Integer

　Set NewSH = Sheets.Add(Before:=Sheets(1))
　NewSH.Cells(2, 1).Value = "名前"
　NewSH.Cells(2, 2).Value = "ID"
　RowEP = 3
　ColEP = 3

　For Each TgtSH In Worksheets
　　If TgtSH.Name <> NewSH.Name Then
　　　RowRP = 1
　　　RPhase = 1
　　　Do While (TgtSH.Cells(RowRP, 2) <> 0)
　　　　Select Case RPhase
　　　　Case 1
　　　　　SysStr = TgtSH.Cells(RowRP, 2)
　　　　　SysNum = TgtSH.Cells(RowRP, 3)
　　　　　VerSum = 0
　　　　　RPhase = 2
　　　　Case 2
　　　　　VerStr = TgtSH.Cells(RowRP, 2)
　　　　　VerNum = TgtSH.Cells(RowRP, 3)
　　　　　VerSum = VerSum + VerNum
　　　　　NamCnt = 0
　　　　　RPhase = 3
　　　　Case 3
　　　　　With NewSH
　　　　　　Set c = Range(.Cells(3, 2), .Cells(RowEP, 2)).Find(TgtSH.Cells(RowRP + 1, 2))
　　　　　　If c Is Nothing Then
　　　　　　　RowWP = RowEP
　　　　　　　.Cells(RowWP, 1) = TgtSH.Cells(RowRP, 2)
　　　　　　　.Cells(RowWP, 2) = TgtSH.Cells(RowRP + 1, 2)
　　　　　　　RowEP = RowEP + 1
　　　　　　Else
　　　　　　　RowWP = c.Row
　　　　　　End If
　　　　　　Set d = Range(.Cells(1, 3), .Cells(1, ColEP)).Find(SysStr)
　　　　　　If d Is Nothing Then
　　　　　　　.Cells(1, ColEP) = SysStr
　　　　　　　.Cells(2, ColEP) = VerStr
　　　　　　　ColWP = ColEP
　　　　　　　ColEP = ColEP + 1
　　　　　　Else
　　　　　　　If .Cells(2, d.Column) = VerStr Then
　　　　　　　　ColWP = d.Column
　　　　　　　Else
　　　　　　　　e# = 1
　　　　　　　　Do While (1)
　　　　　　　　　ColWP = d.Column + e
　　　　　　　　　If .Cells(1, ColWP) = "" And .Cells(2, ColWP) = VerStr Then
　　　　　　　　　　Exit Do
　　　　　　　　　ElseIf .Cells(2, ColWP) = "" Then
　　　　　　　　　　.Cells(2, ColWP) = VerStr
　　　　　　　　　　ColEP = ColEP + 1
　　　　　　　　　　Exit Do
　　　　　　　　　ElseIf .Cells(1, ColWP) <> SysStr Then
　　　　　　　　　　.Columns(ColWP).Insert
　　　　　　　　　　.Cells(2, ColWP) = VerStr
　　　　　　　　　　ColEP = ColEP + 1
　　　　　　　　　　Exit Do
　　　　　　　　　End If
　　　　　　　　Loop
　　　　　　　End If
　　　　　　End If
　　　　　　.Cells(RowWP, ColWP) = .Cells(RowWP, ColWP) + 1
　　　　　End With
　　　　　NamCnt = NamCnt + 1
　　　　　RPhase = IIf(VerNum = NamCnt, IIf(SysNum = VerSum, 1, 2), 3)
　　　　　RowRP = RowRP + 1
　　　　End Select
　　　　RowRP = RowRP + 1
　　　Loop
　　End If
　Next TgtSH
　MsgBox "終了しました"
End Sub
'--------------------(ここまでコピー)-----------------------

6) 貼り付けた部分のどこでも良いから、コードの途中をマウスでクリックし、F5キーを押す
7) 「終了しました」が表示されたら「OK」ボタンをクリックし、Visual Basic Editorを終了する


これで、対象ブックの先頭に新しいシートが作成されたはずです。

当方Excel2003で検証したため、もしかしたら2007以降では動作しない可能性もあります。その際は御容赦ください。

もし「終了しました」メッセージ以外のメッセージが出て、そこに「デバッグ」というボタンがあった場合は、デバッグをクリックし、Visual Basic Editor で黄色に染まった行の内容を補足欄に記入してください。チェックしたあとはもう一回F5を押し同じメッセージを表示させた後、「終了」を押してください。何時間も処理が終わらないようなら、Escキーを押して実行を止めてください。その際は空白のExcelブックに1シートずつシートをコピーしてから上の操作を確かめ、どのシートが悪さをしているのかチェックしてみてください。

結果を図示します。右の2枚のシートから、左の表が出来上がることを想定しています。なお、罫線やテキスト配置などは後から手作業にて作成しています。見やすいように別々のブックに展開していますが、実際は同一のブックの中で実現されています。

この回答への補足

matsu_junさん


とても詳しい説明、本当にありがとうございます。そして私の説明に不備があったので、訂正をさせていただきます。


前提1) C列の「人数」は正確である。(システム名、バージョン名の右側の数字が合っていればOK、下記のマクロは名前および個人コード右側の数字は関知しない)
　⇒正確です。ただし個人名の隣の数字が「１」以外のこともあります。（1個人がIDを複数持っている時、メンテナンス用のユーザーがIDを5つ持っていたりする時など）

前提2) C列の「人数」は半角数字であり、その他文字は入っていない。入っていたら恐らくエラーを発生します。もし覚え書き程度の記載があれば、それは削除してください。
　⇒すべて半角数字でした。太字になっているものもありますが、全角のものや数字以外のものはありません。

前提3) 各シート 1行目から必ずデータが始まる。1行目に、一般的な表でよくあるところの表題など余計なものがあれば、事前に削除してください。
　⇒1行目から始まっています。

前提7) 一人の人物に対し、複数の個人IDを持つことは絶対に無い
　⇒あります。二つ持っている人は記載が
Ai Ueo　　2
　ABCDE　 1
　JKALM　　1
といった感じになります。


また、ローマ字で表現されている個人名のほかに、テスト用の名前（User123など）があります。
IDも個人に振られているものは大文字5桁ですが、メンテナンス用にふられているものはMAINTENANCEとなっていたりします。


matsu_junさんに記載していただいたマクロを一度試しました。
イメージに近いものにはなりました！
しかし、やはり私の記載が悪かったので、表の途中から個人名であるはずの部分がIDになっていたり、行のところに個人名とIDが表記されたりしていました。

もし、お時間があれば助けていただきたいです。
データが膨大すぎ、手作業の限界に達してしまいそうです（；＿；）

補足日時：2011/10/20 13:17

No.2 回答者： kagakusuki 回答日時： 2011/10/18 15:43

>「バージョン」や「システム」といった言葉は必ず含められていないんです。

　データをパソコンで自動的に整理する様にするためには、どうしても、どれが機材名なのかという事と、どれがバージョン名であるのかという事を、区別するための明確な基準が必要になります。
　ですから、機材名を表す文字列に共通の特徴は何であるのかという事と、バージョン名を表す文字列に共通の特徴は何であるのかという事を、御教え頂けなければ、自動化させる事は出来ません。
　添付画像のデータを見た限りでは、

(1)機材名には必ず「-」が含まれているが、機材名以外には「-」は含まれていない。
(2)バージョン名は、必ず数字と「.」のみから成り立っていて、アルファベット等の数字以外の文字は含まれておらず、バージョン名以外には、数字と「.」のみから成り立っている文字列は無い
(3)文字列の先頭にスペースが無いのは、必ず機材名である
(4)文字列の先頭に全角のスペースが1つだけ付いているものは必ずバージョン名であり、文字列の先頭に付いている全角スペースの数は1つでは無いものはバージョン名ではない

という特徴がある様に見えますが、この条件で、全ての機材名とバージョン名を区別出来るか否かを御教え願います。
　特に、「-」や「.」、及び文字列の先頭についているスペースが、各々、半角文字であるのか、それとも全角文字であるのかという事と、
バージョン名の文字列の先頭についているスペースの数が本当に1個なのかという事、
それと、例外は存在するのか否かという事と、例外がある場合には、その例外の全て
を御教え願います。

　因みに、もし上記の(1)～(4)の条件が正しい場合には、前回のQNo.7071258のANo.4において、私が回答した方法の一部を修正するだけで自動化出来ます。
　まず、補助シートのI2セルに入力する数式を、次の数式と差し替えて下さい。

=IF(AND(ISNUMBER($F2),COUNTIF($E$1:$E2,$E2)=1),ROW(),"")

　その上で、下記の様に一部の数式を差し替えて下さい。
【条件(1)が正しい場合】
　補助シートのF1セルに入力する数式を、次の数式と差し替えて下さい。

=IF(ISNUMBER(FIND("-",$E1)),ROW(),"")


【条件(2)が正しい場合】
　補助シートのG1セルに入力する数式を、次の数式と差し替えて下さい。

=IF(AND($E1<>"",ISNUMBER(SUBSTITUTE(ASC($E1),".",)+0)),ROW(),"")


【条件(3)が正しい場合】
　補助シートのF1セルに入力する数式を、次の数式と差し替えて下さい。

=IF(LEFT(ASC($E1),1)=" ","",ROW())


【条件(4)が正しい場合】
　補助シートのG1セルに入力する数式を、次の数式と差し替えて下さい。

=IF(AND(LEFT(ASC($E1),2)=" ",LEFT(ASC($E1),3)<>" "),ROW(),"")

この回答へのお礼

kagakusukiさん、ありがとうございます。

(1)機材名には必ず「-」が含まれているが、機材名以外には「-」は含まれていない。
　⇒機材名に「-」が含まれていないものも多々あります。個人名には含まれていません。バージョン名に含まれているものもあります。
(2)バージョン名は、必ず数字と「.」のみから成り立っていて、アルファベット等の数字以外の文字は含まれておらず、バージョン名以外には、数字と「.」のみから成り立っている文字列は無い
　⇒「Unknown」と書かれたものや記号が含まれているものもあります。
(3)文字列の先頭にスペースが無いのは、必ず機材名である。
　⇒スペース、というよりインデントで調整しているようです。機材名にはインデント調整はありません。
(4)文字列の先頭に全角のスペースが1つだけ付いているものは必ずバージョン名であり、文字列の先頭に付いている全角スペースの数は1つでは無いものはバージョン名ではない
　⇒スペースではなく、インデントで調整されているようです。規則的に調整はされています。

前回の質問から引き続き、アドバイスをいただきありがとうございます。
４つの質問に答えさせていただきました。
データを見れば見るほど「規則性ゼロ・・・」と思うばかりです。
手作業で進めてはいますが、もし少しでも楽ができる方法があればと願うばかりです（涙）

お礼日時：2011/10/18 17:16

No.1 回答者： noname#158634 回答日時： 2011/10/18 12:02

条件が複雑すぎて、マクロや関数でやろうとすると余計にごちゃごちゃしてしまうパターンです。

＞列Bにシステム名・そのシステムのバージョン・名前・その人の個人IDが、
＞列Cには人数が書かれています。

＞１行目に名前・ID・機材名とバージョンずらずらずら
＞２行目から個人名・その人のID・1行目に書いている機材を使用しているか（使用していたら○をつけたい）
＞という感じです。

既にお分かりだと思いますが、配置が大幅に異なる上に「機材を使用しているか（使用していたら○をつけたい）」という条件付項目まで存在します(上と下で項目名がそもそも一致していないのはまあ記述ミスでしょうから無視します)。
それに対して一気に対応しきるというのはさすがに無理があるでしょう。
なのでたとえば、「個人名」と「個人ID」が上下に隣接しているのは確実でしょうから、個人名のセルの横のF列あたりの空きスペースで「=B3&"・"&B4」などとして値が連結された一覧を作る、一覧をコピーして隣の列にでも「形式を選択して貼り付け」＞「値」で貼り付ける、などの操作で地道にやるのがむしろ早く済むと思われます。



※以下本音
画像のような形式で70シートもあるなら一箇所にまとめた時点で絶対に見やすくなんてならないと思う。

この回答へのお礼

tk-is-pg1206さん

早速のアドバイスありがとうございます！
そうなんです、マクロでやろうにもややこしくって・・・
現段階で手作業で作ってますが、かなりのデータ数です。
見にくいですが、新入社員なもので逆らえません・・・
今週中には終わらせれるようがんばります。

お礼日時：2011/10/18 17:05