2つのテーブルを一つにまとめる方法

Question

前提・実現したいこと

スケジュールと出勤簿をひとつにまとめたいです。

予定表（スケジュール）は日付毎、人毎の表になっております。
日報（出勤簿）はデータです。
日報はピポッドテーブルにて集計表を作成しております。

【予定表】
・可変します
・2行目に氏名
・A列に日付

【日報】
・行数は可変します
・A列からK列

予定表と日報の日付と氏名は実際はまったく同じではありません。
予定表の方が多かったり、日報の方が多かったりと一部もしくは全部一致します。

略号は分かりやすく「aa」のみにしておりますが本当は複数あります。

【ピポッドテーブル】

発生している問題・エラーメッセージ

図のようにシート"結合"に予定表と日報を人毎（予定表の順番で）に横に並べて表示させたいです。
予定表の氏名順と同じようにピポッドテーブルの氏名順番を変更させる方法がありましたら、教えて頂けないでしょうか
宜しくお願いいたします

該当のソースコード

Private Sub CommandButton3_Click()
  Dim DataS As Worksheet 
  Dim ws As Worksheet
  Dim pvc As PivotCache
  Dim pvt As PivotTable

  
  Set ws = Sheets.Add
  ActiveSheet.Name = "ピボットテーブル"
  Set DataS = ThisWorkbook.Worksheets("日報")

  
  Set pvc = ActiveWorkbook.PivotCaches.Create( _
              SourceType:=xlDatabase, _
              SourceData:=DataS.Range("A:K"), _
              Version:=xlPivotTableVersion15)

  
   
   Set pvt = pvc.CreatePivotTable( _
               TableDestination:=ws.Name & "!R3C1", _
               TableName:="ﾋﾟﾎﾞｯﾄﾃｰﾌﾞﾙ1", _
               DefaultVersion:=xlPivotTableVersion15)

  
   With pvt.PivotFields("略号")
     .Orientation = xlRowField
     .Position = 1
   End With

  
   With pvt.PivotFields("日付")
     .Orientation = xlRowField
     .Position = 2
   End With
   
   
   With pvt.PivotFields("氏名")
     .Orientation = xlColumnField

     .Position = 1
   End With
   

   
   pvt.AddDataField pvt.PivotFields("執務時間"), "合計 / 執務時間", xlSum

End Sub

Comments

[otn]

> ピポッドテーブル
→ ピボットテーブル
> 可変します
→ 変化します

[ichigo15]

ご指摘ありがとうございます。
比較する方法がありましたら教えて頂けないでしょうか
宜しくお願いいたします

Answer 1

難儀されてますね。
無理難題の要求に付き合わされて、心中お察しします。
多分完成するまでにこのプロジェクトは無かったことになりそうな気がしますが。。。

予定の入力(クロス集計表形式）
（提示の形でもいいですが、めんどくさかったのでリスト形式を先に作って
サンプル用にピボットテーブルでクロス集計表を作りました。
逆も出来る機能があれば便利なんですけどね＾＾；自作するのもそんな大した労力は要らないですが）

これを一旦リスト形式にします。

次に日報の入力

予定のリストと実施のリストを統合します。（別途区分を追加します）

これをもとにピボットテーブルで集計します。

これをコピーしてリンク貼り付けします

で数式を、数式バーのような式に直します。
必要な個所にドラッグ

並べ替えは、仕様書に基づいて順番に見て行って、
一つ目は、織田なので、織田を1列目へ
二つ目は、徳川だけど、ないのでパス
三つ目は、豊臣だから、豊臣を3列目へ
四つ目は、斉藤なので、斉藤を5列目へ
と移動すればいいですよね？

移動のコードは、マクロの記録で分かると思うので、
まずは手動でドラッグして記録してみましょう。

これらの作業をマクロで自動化すればいいかなと思います。
もちろん、細かい微調整もありますが。

んと、慣れないと見難いのはわかりますが、
人に合わせてプログラムを作ることは可能ですが、
難易度が高くなります。

エクセルを使うのが前提条件なら、人がエクセルに合わせてやることもしないと、
開発に時間が掛かるばかりで運用が出来ませんよ。
ましてや、本職で無く素人が勉強しながら作るのですから数か月から1年以上かかるかも知れないのは、
覚悟するべきです。
その時間の給料が払えるなら、10万円くらいで委託できたりしないですかねぇ。。。相場は知らないですが、
（1行1000円でしたっけ？）
フリーランスとか頼めば割と安くできるし、動作確認も含め、1ヶ月もあれば完成するのでは？

Comments

[ichigo15]

コメントありがとうございます。

ご指摘のとおり、外部委託、もしくは各人で比較表が作成できるぐらいに
スキルアップしてくれたらいいのですが難しいみたいです

こちらこそ色々とご指導いただきまして感謝いたします。

Answer 2

結合とピボットテーブル二つ要望がありますが、
ピボットテーブルを自身で定義した順番でソートする方法です。
定義順をユーザー設定リストに登録してそれを利用すれば任意の順番に並び変えることができます。
このソースでは予定表の2行目の名前順を取得しユーザー設定リストに登録しています。
またユーザー設定リストはブックではなくシステムで管理されているので
ゴミが残るのを防止するためソート後に削除しています。

Sub CommandButton3_Click()

・・・
  Dim pEndColumn As Long
  Dim SortData As Variant
・・・
  
  pvt.AddDataField pvt.PivotFields("執務時間"), "合計 / 執務時間", xlSum

  With ThisWorkbook.Worksheets("予定表")
    pEndColumn = .Cells(2, .Columns.Count).End(xlToLeft).Column
    '予定2行目の氏名順をリストで取得する
    SortData = .Range(.Cells(2, 2), .Cells(2, pEndColumn))
  End With
  
    '取得したリストをユーザー設定リストに登録
  Application.AddCustomList ListArray:=SortData
   
  'ユーザー設定リスト登録位置を取得
  ocNum = Application.GetCustomListNum(SortData)

  '登録したユーザー設定リストでピボットテーブルをソート
  ActiveSheet.Range("$B$4").Sort Order1:=xlAscending, Type:=xlSortLabels, _
    OrderCustom:=ocNum + 1, Orientation:=xlLeftToRight, SortMethod:=xlStroke
               
  'ユーザー設定リストを削除
  Application.DeleteCustomList ListNum:=ocNum

End Sub

追記
書いてしまってからなんですが少し不安定な方法のようです。
ユーザー設定リストを削除する前にブックを保存しておくと落ちるのは防げます。
ただソートする時に保存されてしまうのでそこの動作に関してはご了承ください。
end-u様の教えてくださった方法でブック保存時の不具合の問題は解決しました。

  Application.DisplayAlerts = False
  
  With ThisWorkbook.Worksheets("予定表")
    pEndColumn = .Cells(2, .Columns.Count).End(xlToLeft).Column
    '予定2行目の氏名順をリストで取得する
    SortData = .Range(.Cells(2, 2), .Cells(2, pEndColumn))
  End With

    '取得したリストをユーザー設定リストに登録
  Application.AddCustomList ListArray:=SortData

  'ユーザー設定リスト登録位置を取得
  ocNum = Application.GetCustomListNum(SortData)

  '登録したユーザー設定リストでピボットテーブルをソート
  ThisWorkbook.Worksheets("ピボットテーブル").Range("$B$4").Sort Order1:=xlAscending, Type:=xlSortLabels, _
    OrderCustom:=ocNum + 1, Orientation:=xlLeftToRight, SortMethod:=xlStroke

  'ピボットテーブルに設定されているソート条件のクリア
  ThisWorkbook.Worksheets("ピボットテーブル").Sort.SortFields.Clear

  'ユーザー設定リストを削除
  Application.DeleteCustomList ocNum
  
  Application.DisplayAlerts = True

Comments

[ichigo15]

コメントありがとうございます。

当初のコードと別に実行しましたら思いどおりにはなってのですが、その後Excelが自動で閉じてしまい
結果が消えてしまいました。

Application.DeleteCustomList ListNum:=ocNum
　↓
'Application.DeleteCustomList ListNum:=ocNum

と実行できないようにするとExcelが落ちなくなりましたが、今度はさっきまでよかった他のマクロの結果がおかしいことになってきました。
知識が低くて申し訳ございませんがこちらのコードが関係していたりするのでしょうか。

[ichigo15]

コメントありがとうございます。

一旦、落ちてまた同じ画面が開きました。
また、明日試してみようと思います。

[end-u]

Excel2010以降、Sortに使用したユーザー設定リストを削除した場合、保存時にExcelが落ちる現象があります
ver2007でSortオブジェクトが追加され、下位ver互換のSortメソッドを実行した場合でも、このSortオブジェクトのSortFieldsにSort条件が記憶されます
CustomListだけ削除してもこのSortFieldsに情報が残っているからExcelが異常終了するそうです
https://answers.microsoft.com/ja-jp/office/forum/office_2013_release-excel/excel2013%E3%81%AB%E3%81%A6%E3%83%9E%E3%82%AF/e2c7bee5-23a2-46d7-8cd1-cfa3a8588a03?auth=1

なので..
ThisWorkbook.Worksheets("ピボットテーブル").Sort.SortFields.Clear
Application.DeleteCustomList ocNum
..とすると回避できるかと思います

[yureighost]

end-u様
これはよい情報をありがとうございます。
確かにその方法で保存時の不具合が発生しなくなりました。

[ichigo15]

コメントありがとうございます。

一旦、落ちることはなくなりました。
ですが、他のマクロの結果がおかしくなっております。
一度失敗してしまったマクロを修正しても全く結果が出なくなったり、マクロの結果が複数でてしまったりです。
一度の失敗とはシートの指定を忘れていたのでアクティブシートで処理されてしまいましたが、修正済みです。

もしかして
'Application.DeleteCustomList ListNum:=ocNum
としてしまった間の記録が積みあがって結果に反映されていたりということはあるのでしょうか

エラーがでるわけでもなく、知識が低いため困っております
申し訳ございませんが記録を消す方法等をご存じでしたら教えていただけますでしょうか。

[yureighost]

ユーザー設定リストは手動で見る場合、
ファイル＞オプション＞詳細設定＞(詳細設定メニューのかなり下)ユーザー設定リストの編集
です。
そこに自分が登録したと思われるリストがないか確認してみてください。

Answer 3

予定表と日報の日付と氏名は実際はまったく同じではありません。
予定表の方が多かったり、日報の方が多かったりと一部もしくは全部一致します。

まずは、この状態をなんとかしましょう
でないとまとまるものもまとまりません
どちらかというと、「予定表」をベースとしたほうが後の処理がラクです
最低限、「予定表」と「日報」の氏名は揃えましょう
日付は、入力がない場合でも「予定表」に組み込む事は簡単にできますよね

その整理ができた前提での提案です
1.「日報」から氏名と日付をキーにしてピボットテーブルを作成する
2.「予定表」をコピー、加工して、1で作成したピボットテーブルを参照する数式を入れる

具体的には
1.のピボットテーブルを作成すると図1のようになります
（図1）

2.の「予定表」をコピー、加工というのは、図2のように氏名の後ろに列を挿入します
（図2）

その後 C3セルに数式を入れます　=のあとに図3のように1で作成したピボットテーブルの該当データを選択すると
=GETPIVOTDATA("執務時間",Sheet1!$A$3,"日付",DATE(2020,3,1),"氏名","織田")
のように式が入ります
（図3）

数式を手修正します
（図4）

=GETPIVOTDATA("執務時間",Sheet1!$A$3,"日付",$A3,"氏名",B$2)
日付は列固定で $A3
氏名は行固定で B$2

修正後の式を下方向と各氏名の後に挿入した列にコピーすると良いです
必要に応じて要所要所をマクロ化すれば良いでしょう

（追記）
ぁ一応、逆に日報ベースの別案も作ってはいましたけどね
ピボットをベースに予定表の内容がMatchするものをひっぱってくる感じ。
提示のレイアウト限定ではありますが

Sub test()
    Dim r  As Range
    Dim d  As Range
    Dim dd As Range
    Dim cc As Range
    Dim rr As Range

    With Sheets("日報")
        'PivotTableのSourceData
        Set r = .Range("K1", .Cells(.Rows.Count, 4).End(xlUp).Offset(, -3))
    End With

    'とりあえず新規Sheetに集計してみる
    With ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, _
                                        SourceData:=r).CreatePivotTable("")
        .PivotFields("日付").Orientation = xlRowField
        .PivotFields("氏名").Orientation = xlColumnField
        '"略号"の集計はダミー。後で数式セット
        .AddDataField .PivotFields("略号"), "略号&場所", xlCount
        .AddDataField .PivotFields("執務時間"), "執務時間計", xlSum
        .DataPivotField.Orientation = xlColumnField
        .ColumnGrand = False
        .RowGrand = False
        .RowAxisLayout xlTabularRow
        '"略号&場所"の範囲取得
        .PivotSelect "'略号&場所'", xlDataOnly
        Set d = Selection
        .TableRange2.Copy
        'PivotTableを解除
        .TableRange2.PasteSpecial xlPasteValues
    End With
    Application.CutCopyMode = False

    '数式の参照先アドレスget
    With Sheets("予定表")
        Set r = .Range("A2").CurrentRegion
        Set dd = .Range("B3", r(r.Count))
    End With
    Set cc = dd.Resize(1).Offset(-1)
    Set rr = dd.Resize(, 1).Offset(, -1)

    '数式文字列設定 =INDEX(dd,MATCH($A4,rr,0),MATCH(B$2,cc,0))&""
    Dim s(2) As String
    s(0) = "=index(" & dd.Address(, , , True)
    s(1) = "match($A4," & rr.Address(, , , True) & ",0)"
    s(2) = "match(B$2," & cc.Address(, , , True) & ",0))&"""""
    d.Formula = Join(s, ",")
    '数式の値化が必要であれば以下コメント活かす
    'For Each r In d.Areas
    '    r.Value = r.Value
    'Next
End Sub

（2020.04.02追加）
..なんか自分でも納得いかないコードですが..
すみません、「こんなアプローチもあります」的なサンプル扱いでお願いします

Sub test2()
    Dim r  As Range
    Dim d  As Range
    Dim dd As Range
    Dim cc As Range
    Dim rr As Range
    Dim x  As Long
    Dim i  As Long
    Dim j  As Long
    Dim k  As Long

    '予定表の範囲を取得
    With Sheets("予定表")
        Set r = .Range("A2").CurrentRegion
        Set dd = .Range("B3", r(r.Count))
    End With
    Set cc = dd.Resize(1).Offset(-1)
    Set rr = dd.Resize(, 1).Offset(, -1)

    Dim pt As PivotTable
    Dim st As String
    Dim ws As Worksheet
    Set ws = Sheets.Add
    
    With Sheets("日報")
        x = .Cells(.Rows.Count, 10).End(xlUp).Row
        k = x + 1 '最後のデータクリアで使う
        
        '日報から氏名、日付、略号場所キーでピボット作成 _
         後で日報ベースの予定｜実績の実績データ追加で使う
        Set r = .Range("A1", .Cells(x, "L"))
        r.Columns("L").Formula = "=B1&H1"
        st = .Range("L1").Value
        Set pt = ActiveWorkbook.PivotCaches.Add( _
                                SourceType:=xlDatabase, _
                                SourceData:=r) _
                                .CreatePivotTable(ws.Range("A1"))
        pt.ColumnGrand = False
        pt.RowGrand = False
        pt.RowAxisLayout xlTabularRow
        With pt.PivotFields("氏名")
            .Orientation = xlRowField
            .Subtotals(1) = False
        End With
        With pt.PivotFields("日付")
            .Orientation = xlRowField
            .Subtotals(1) = False
        End With
        pt.PivotFields(st).Orientation = xlRowField
        pt.AddDataField pt.PivotFields("執務時間"), "執務時間計", xlSum
        '予定表の氏名と日付を日報に追加
        x = x + 1
        For i = 1 To rr.Count
            For j = 1 To cc.Count
                If dd(i, j).Value <> "" Then
                    .Cells(x, "D").Value = rr(i).Value
                    .Cells(x, "J").Value = cc(j).Value
                    x = x + 1
                End If
            Next
        Next
        Set r = .Range("A1", .Cells(x - 1, "L"))
    End With
    'ピボット利用して「結合」シート作成
    Dim ws2 As Worksheet
    Set ws2 = Sheets.Add
    With ActiveWorkbook.PivotCaches.Add( _
                        SourceType:=xlDatabase, _
                        SourceData:=r) _
                        .CreatePivotTable(ws2.Range("A1"))
        .ColumnGrand = False
        .RowGrand = False
        .RowAxisLayout xlTabularRow
        .PivotFields("日付").Orientation = xlRowField
        .PivotFields("氏名").Orientation = xlColumnField
        .AddDataField .PivotFields("略号"), "予定｜実績", xlCount
        .AddDataField .PivotFields("執務時間"), "執務時間計", xlSum
        .DataPivotField.Orientation = xlColumnField
        '"予定｜実績"の範囲取得
        .PivotSelect "予定｜実績", xlDataOnly
        Set d = Selection
        'PivotTableを解除
        .TableRange2.Copy
        .TableRange2.PasteSpecial xlPasteValues
    End With
    Application.CutCopyMode = False

    '予定表から予定｜実績データ追加 _
     数式文字列設定 =INDEX(dd,MATCH($A4,rr,0),MATCH(B$2,cc,0))&""
    Dim s(2) As String
    s(0) = "=index(" & dd.Address(, , , True)
    s(1) = "match($A4," & rr.Address(, , , True) & ",0)"
    s(2) = "match(B$2," & cc.Address(, , , True) & ",0))&"""""
    d.Formula = Join(s, ",")
    
    '日報ベースの予定｜実績の実績データ追加
    Dim r1 As Range
    Dim r2 As Range
    Dim y
    ws.Activate
    Set rr = d.Areas(1).Offset(, -1)
    For Each r1 In d.Areas
        r1.Value = r1.Value
        pt.PivotSelect r1(1).Offset(-2).Value, xlLabelOnly
        For Each r2 In Selection.Offset(, 1)
            y = Application.Match(CLng(r2.Value), rr, 0)
            If IsNumeric(y) Then
                r1(y).Value = CStr(r1(y).Value) & "｜" & r2.Offset(, 1).Value
            End If
        Next
    Next
    '追加したダミーデータと作業用Sheetをクリア
    r.Columns("L").ClearContents
    Range(r(k, 1), r(r.Count)).ClearContents
    Application.DisplayAlerts = False
    ws.Delete
    Application.DisplayAlerts = True
End Sub

Comments

[ichigo15]

コメントありがとうございます。

＞まずは、この状態をなんとかしましょう
＞でないとまとまるものもまとまりません
＞どちらかというと、「予定表」をベースとしたほうが後の処理がラクです

予定表と日報が異なる部分を見つけることも作成の目的であります。
例えば、豊臣の3/8、明智の3/16等です。
また、予定表も日報も予定していない日や稼働していない日は作成されない仕様となっております。
ですので、せっかくご提案いただきましたが、どちらかに揃えることは難しいです。

＞最低限、「予定表」と「日報」の氏名は揃えましょう

そうなのです。
予定表とピボットテーブルの氏名の順番が違うので困っています。
これがクリアできれば希望通りになりそうなのですが。。。。
手動で並べ替えができない人がいるので一連の動きをVBAで作成しようと思っております。
ピポッドテーブルを予定表の順番に出力させる方法がないか調べております。

[end-u]

> 最低限、「予定表」と「日報」の氏名は揃えましょう
これは、『順番』を揃えましょう、という意味ではないです

例えば「Ａ表」と「Ｂ表」という２つの異なるデータを照合する時に、キーとなる「何か」が必要で、
それが「氏名」なら、同一キーと判断できるように、
「豊臣」「豊臣秀吉」「豊臣　秀吉」「豊冨　秀吉」など表記ゆれがないように揃えてください
、という意味です
これが無理なら、何をもって「Ａ表」と「Ｂ表」を照合させるのか、という問題になります

私の提案は２案とも「氏名」をキーとして数式で引っ張ってきますから、順番を揃える必要はありません

質問文にイメージ画像があるわけですから、サンプルデータが手元にありますよね
私が提示した手法を実際に試してみてもらえませんか

> 予定表と日報が異なる部分を見つけることも作成の目的であります。
これも目的に含めるなら、貴方から提示された「結合」シートの仕様自体変更が必要になる気がします
「2つのテーブルを一つにまとめる方法」ではなくて
「2つの明細データを一つにまとめて一つのテーブルで集計する方法」が簡単じゃないでしょうか

[end-u]

いぁ、もう余計な事は置いといて
> 予定表の氏名順と同じようにピポッドテーブルの氏名順番を変更させる方法がありましたら、教えて頂けないでしょうか
これに特化したコード。
Sub sample()
　　Dim r As Range
　　With Sheets("予定表")
　　　　Set r = .Range("B2", .Range("B2").End(xlToRight))
　　End With
　　Dim i As Long
　　With Sheets("ピボットテーブル").PivotTables(1).PivotFields("氏名")
　　　　For i = 1 To r.Count - 1
　　　　　　.PivotItems(r(i).Value).Position = i
　　　　Next
　　End With
End Sub

[ichigo15]

コメントありがとうございます。

よく理解できておらず申し訳ございません。
予定表と日報の氏名の表記方法はまったく同じです。
ですが、必ずしも予定していた日程、メンバーとは異なる場合があります。
追記のコードではやはり日報にないものはひっぱってこれていないようでした。

[end-u]

> 追記のコードではやはり日報にないものはひっぱってこれていないようでした。
..『日報ベース』ですからねえ..
> 予定表とピボットテーブルの氏名の順番が違うので困っています。
> これがクリアできれば希望通りになりそうなのですが。。。。
クリアされてるかと思うんですがその辺りどうなんでしょう
一応、サンプル追加しておきました
（完全）動作保証ってわけではありませんので手法のひとつとして参考になればさいわいです

[ichigo15]

コメントありがとうございます。

予定表とピボットテーブルの氏名の順番が揃うようになりました。
無事に思い通りのことができるようになりました、感謝いたします。

できれば、追加で教えて頂いたコードのことで教えて頂きたいのですがMATCH関数で
＃N/Aになった場合にエラーになってしまったので「＝IFERROR(　、””）」を追加
しようとしたのですが、関数をマクロで入力させるのが初めてで上手くいきません
今後の為に教えて頂けますでしょうか
よろしくお願いいたします。

Dim s(3) As String
s(0) = "=iferror("
s(1) = "index(" & dd.Address(, , , True)
s(2) = "match($A4," & rr.Address(, , , True) & ",0)"
s(3) = "match(B$2," & cc.Address(, , , True) & ",0))&"""""",""""")
d.Formula = Join(s, ",")

[end-u]

エラーだったら,""　ですね
VBAで数式に文字として　"　ダブルクォートを入れたい場合は　""　と2個重ねます
数式で　""　なら　""""　です

Join(s, ",")　は、文字列配列 s の要素を ,（カンマ）でつなげるので、配列要素を増やしたら不要な , でつながってしまいます

なので
Dim s(2) As String
s(0) = "=iferror(index(" & dd.Address(, , , True)
s(1) = "match($A4," & rr.Address(, , , True) & ",0)"
s(2) = "match(B$2," & cc.Address(, , , True) & ",0)),"""")&"""""

[ichigo15]

コメントありがとうございます。

テストデータではエラーでなくなりました。
実際のデータで試してみたのですが

y = Application.Match(CLng(r2.Value), rr, 0)
実行時エラー13
型が一致しません

となります。
教えていただけますでしょうか。
よろしくお願いいたします。

[end-u]

予定表の氏名順にピポッドテーブルの氏名を並び替えることで解決したんですよね？
無理にそのサンプルコードを使わなくてもいいんじゃないでしょうか
「手法のひとつとして参考に」していただければ良いかと。
テストデータで動いてて、実際のデータがこちらにあるのではないので、貴方のほうで確認するしかないですよ
エラーで止まった時のr2.Valueの値を調べてください
https://www.tipsfound.com/vba/01010
https://www.excelspeedup.com/vbadebug/
デバッグのやり方を知っておかないと、そのコードが何をやってるか理解するのは難しいです
自分で修正できないコードを実務で使っても、仕様が変わったら使い物にならなくなります

一応、エラー起こす可能性を推測で書くと、日報の日付欄に、日付データと認識できない文字列があるのではないでしょうか
最初のピボットテーブルの範囲の最終行を
> x = .Cells(.Rows.Count, 10).End(xlUp).Row
このコードで取得しています
J列の氏名を基準にしています
その範囲の日付欄を調べてください
空白があってもエラーになります

また、途中でエラーで止まった場合、日報シートに、作業用として追加した予定表のデータとL列の数式が残ったままとなっていますので手動で削除してください

Answer 4

したいことは、「結合」っていうシートを作ることですよね？
どこまでができていて、どこができていないのかが正直十分に理解できていません。
ピポットテーブルは質問に関する情報を何か持っていますか？

現時点で読んだ限り、まず大枠から考えると、「予定表」をベースにし、
「日報」の中の「日付」と「氏名」が該当する行の「略号」と「場所」と「執務時間」を当てはめればいいのかなと思いました。

まず、VBAとかは置いておいて、一般的なアルゴリズム的に結合したいということは、
1．まずは、「予定表」と「日報」シートから表のデータを取ってくる。
2．「日報」で、主キーを決める。主キー（複合キー）は、◎列と〇列と△列を決めればどこか一つの行に必ず決まるという項目です。（ここでは、「日付」と「氏名」のはず）
3．「日報」を１行ずつ見て、主キーの組み合わせになる場所を「予定表」から探す。
4．そこに「略号」と「場所」と「執務時間」を入れる。

これを「日報」すべての行に実施すると、求めたい表のデータは形成できると思います。
それをVBAのプログラムに落とし込めば、あとは表示するときの微調整だけで済みます。

なので、そのソースコードを作ってみましょう。

※質問内容が十分に読み取れていないかもしれません、回答内容が見当違いであればすみません

Comments

[ichigo15]

コメントありがとうございます。

日報は元々、ピポッドテーブルで集計していたので、こちらを使ってひとつにまとめようとしたのですが
予定表とピボットテーブルの氏名の順番が違うので困っています。

日報は表示しておりませんが、業務内容によって分かれております。
ですので、3/1の織田のように、同じ日付で同じ氏名で複数ある場合があります。
ご提案の方法に執務時間の合算を組み込まないといけなくなるかもしれません。