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

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://okwave.jp/qa/q7071258.html を見つけ、参照しました)

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

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

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

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