スキルアップ・問題解決なら、モーグにおまかせ！

毎日の作業を重複する作業ごとに時間も足して1ヶ月分まとめた表を作りたいです
 
             1日　　　　　　　　　2日　　　　　　　　・・・・31日
　　　A　　　B　　C　　 D　　 E　　F　 　G　　
　　　　　　作業　計画　結果　　作業　計画　結果
１　Aさん　 A　　1　　 １　　　　A　　1　　　 １
２　　　　　B　　２　　２　　　　B　　２　　　２
３　　　　　D　　３　　２　　　　F　　３　　　２
４　　　　　C　　1　　 １　　　 C　　1　　　 １
５ 合計　　　　 ７　　 ６　　　　　　７　　　 ６
--------------------------------------------------------------------------
６　Bさん　 X　　1　　　１　　　 A　　1　　　1
７　　　　　D　　３　　 ２　　　 D　　３　　 ２
８　　　　　　　　　　　　　　
９　　　　　C　　２　　　１　　　 C　　1　　　１
１０ 合計　　　　６　　　４　　　　　　５　　　４
・
・
 ２０　
--------------------------------------------------------------------------
上記は1ヶ月分の作業を１日ごとに、
行った作業、計画した時間、実際の時間を記入していくエクセルのデータ例です。
横に日付ごとに連続していて、縦に一人ずつ連続しています。
 
このデータをもとに下の表のように人ごとに1ヶ月の作業と時間をまとめたいです。
----------------------------------
　　　A　　　B　　　C　　 D　　
　　　　　　作業名　計画　 結果　　
１　Aさん　 A　　　 ３０　　２０　　　　
２　　　　　B　　　 ２０　　２５　　　
３　　　　　D　　 　２０　　１０　　　　
----------------------------------
６　Bさん　 X　　　 １０　　１５　　　
７　　　　　D　　　 ２０　 ２０　　　 　　　　　　　　　　　　　
８　　　　　C　　　 ２０　　１５　　　
----------------------------------　　
【補足】
・作業は行った人が手入力で記入するもので、その日によって行っている作業が異なります。
・作業の間は空白がある場合もあります。
・同一ファイルの別シートに出力したいです。
・10人くらい人数がいるので、それに対応するコードでお願い致します。
・横の連続したデータの間には祝日の空白欄も含まれています。
  
画像のような表を作成するVBAのコードを教えて頂きたいです。
  
教えて頂けると嬉しいです。よろしくお願いします(＞人＜;)

基本的なこと
 
コード作成依頼は、ＮＧです。↓をよく読んでください。
https://www.moug.net/faq/kiyaku.html
 
表のレイアウトを変更する（例えば、リスト形式）と
ＶＢＡでなくても集計できるかも？
 
氏名　日付　作業　計画　結果
Ａさん 10/1 A 1 1
Ａさん 10/1 B 2 2
 
のようなっ形式に変更できるとよいですが・・・・・

既に指摘がありますが、集計に適したデータの持ち方を工夫することが推奨されます。
この手の集計ものは、ピボットテーブルを活用できるような標準的なものにすることですね。
氏名が特定行にしかなかったりするのは、最終的な書類であればOKですが、元データとしては適切ではありません。
 
各月、半年累計、年間累計など、各種の集計などのほか、
今後必要になるかもしれない各種分析（例：作業ごとに見たときの、各人の構成割合分析）等、
ピボットテーブルであれば容易にできます。そうした視点で検討されると良いと思います。
 
 
さはさりながら、当面の課題に対応するとすれば、以下のような方法もあります。
(1)ひとつは、SUMIF関数で集計してしまう方法
(2)Dictionaryを使って、強引に計算する方法など。
 
(1)(2)とも、以下にコードを示しますが、
(1)の方法のデータ例を作業日が2日間の例で示します。（一般性を失うことはありません）
 
■レイアウトと方法(1)の数式例
 

<<Sheet1>>
   A列    B    C    D    E    F    G列        
1        作業 計画 結果 作業 計画 結果
2  Aさん   A    1    1    A    1    1
3          B    2    2    B    2    2
4          D    3    2    F    3    2
5          C    1    1    C    1    1
6  合計         7    6         7    6
7  Bさん   X    1    1    A    1    1
8          D    3    2    D    3    2
9
10         C    2      1  C    1    1
11 合計         6      4       5    4

<<Sheet2>>
     A列     B列       C       D
1    氏名   作業    計画    結果
2    Aさん   A       2       2
3            B       4       4
4            C       2       2
5            D       3       2
6            E       0       0
7            F       3       2
8            X       0       0
9    Bさん   A       1       1
10           B       0       0
11           C       3       2
12           D       6       4
13           E       0       0
14           F       0       0
15           X       1       1

Sub test1()
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim lastRow As Long, lastCol As Long
    Dim rng   As Range
    Dim r     As Range
    Dim r1    As Range, r2 As Range, r3 As Range
    Dim s     As String
    Dim k     As Long
    Dim ary
    Dim cnt As Long
    
    ary = Array("A", "B", "C", "D", "E", "F", "X")  '作業は仮にこの7種だとする 
                                                    '■必要に応じて修正
    cnt = UBound(ary) + 1
    
    Set ws1 = Worksheets("Sheet1") '■必要に応じて修正
    Set ws2 = Worksheets("Sheet2") '■必要に応じて修正

    lastRow = ws1.Cells(Rows.Count, "A").End(xlUp).Row
    lastCol = ws1.Cells(1, Columns.Count).End(xlToLeft).Column
    
    Set rng = ws1.Range("A2", ws1.Cells(lastRow, "A")).SpecialCells(xlCellTypeBlanks)

    ws2.Range("A1:D1") = Array("氏名", "作業", "計画", "結果")
    k = 2
    '各人ごとに作業別の計画数、実行数をSUMIF関数で計算
    For Each r In rng.Areas
        Set r1 = r(1).Offset(-1, 1).Resize(r.Cells.Count + 2, lastCol - 3)
        Set r2 = r1.Offset(, 1)
        Set r3 = r1.Offset(, 2)
        ws2.Cells(k, 1).Resize(cnt, 1) = r1(1).Offset(, -1)
        ws2.Cells(k, 2).Resize(cnt, 1) = Application.Transpose(ary) '作業名

        '作業の計画数を抽出
        s = "=SUMIF(" & r1.Address(True, True, , True) & "," _
                & ws2.Cells(k, 2).Address(False, True) & "," _
                & r2.Address(True, True, , True) & ")"
        ws2.Cells(k, 3).Resize(cnt, 1).Formula = s
      ''値だけにするには
      ''ws2.Cells(k, 3).Resize(cnt, 1).Value = ws2.Cells(k, 3).Resize(cnt, 1).Value
        
        '作業の実行数を抽出
        s = "=SUMIF(" & r1.Address(True, True, , True) & "," _
                & ws2.Cells(k, 2).Address(False, True) & "," _
                & r3.Address(True, True, , True) & ")"
        ws2.Cells(k, 4).Resize(cnt, 1).Formula = s
      ''ws2.Cells(k, 4).Resize(cnt, 1).Value = ws2.Cells(k, 4).Resize(cnt, 1).Value
        k = k + cnt
    Next
    
    '必要なら、このあとで、計画＝0のものだけオートフィルタで抽出し、
    'それを選択して行削除すればよいでしょう。    
    '氏名も、上と同じならフォントの色を白にする条件付き書式を使うとよいでしょう。
    
End Sub

Sub test2()
    Dim ws1 As Worksheet, ws3 As Worksheet
    Dim lastRow As Long, lastCol As Long
    Dim dic   As Object
    Dim dic2  As Object
    Dim d     As Object

    Dim rng   As Range
    Dim r     As Range
    Dim mat, v, ary
    Dim k As Long, j As Long
    Dim pos As Long
    Dim key
    Dim m

    Set ws1 = Worksheets("Sheet1") '■必要に応じて修正
    Set ws3 = Worksheets("Sheet3") '■必要に応じて修正

    lastRow = ws1.Cells(Rows.Count, "A").End(xlUp).Row
    lastCol = ws1.Cells(1, Columns.Count).End(xlToLeft).Column

    Set dic = CreateObject("Scripting.Dictionary")

    Set rng = ws1.Range("A2", ws1.Cells(lastRow, "A")).SpecialCells(xlCellTypeBlanks)
    
    ' Dictionayを使って、計画数、実行数をカウント
    For Each r In rng.Areas
        mat = r(1).Offset(-1, 1).Resize(r.Cells.Count + 1, lastCol).Value
        Set dic2 = CreateObject("Scripting.Dictionary")
        For k = 1 To UBound(mat)
            For j = 1 To UBound(mat, 2) Step 3
                v = mat(k, j)
                If v <> "" Then
                    If dic2.exists(v) Then
                        ary = dic2(v)
                        ary(0) = ary(0) + mat(k, j + 1)
                        ary(1) = ary(1) + mat(k, j + 2)
                        dic2(v) = ary
                    Else
                        ary = Array(mat(k, j + 1), mat(k, j + 2))
                        dic2(v) = ary
                    End If
                End If
            Next
        Next
        Set dic(r(1).Offset(-1).Value) = dic2
        Set dic2 = Nothing
    Next

    '結果出力 -----------
    ws3.Range("A1:D1") = Array("氏名", "作業", "計画", "結果")

    pos = 2 '2行目から書き出す
    For Each key In dic
        Set d = dic(key)
        ws3.Cells(pos, 1).Resize(d.Count, 1) = key
        ws3.Cells(pos, 2).Resize(d.Count, 1) = Application.Transpose(d.keys)
        m = d.items

        For k = 0 To UBound(m)
            ws3.Cells(pos + k, 3).Resize(1, 2) = m(k)
        Next
        pos = pos + d.Count
    Next
    '氏名、作業で昇順ソート
    With ws3
        .Columns("A:D").Sort _
            key1:=.Range("A2"), order1:=xlAscending, _
            key2:=.Range("B2"), order1:=xlAscending, _
            Header:=xlYes
    End With
End Sub

誤解してはいけないので補足します。
例示は二日間だけのものを使っていますが、コードは何日あっても動作するものです。
現実的に使えるものを提示しているつもりです。

コード作成依頼をしてしまいすみませんでした。
丁寧に教えてくださりありがとうございました。
教えて頂いたものを参考に作成させていただきます。