日付の条件にあったユーザに関するセルの貼り付けを実施したい

VBAで、ユーザーの当日シフト表を作成しようとしております。

以下のシートを3つ用意しました

シート1:（列は、4行目から開始されます）
|名前|出勤|シフト1|シフト2|シフト3|シフト4|シフト5|シフト6|
|AAA |++ |--- |--- |--- |--- |--- |--- |
|BBB |++ |--- |--- |--- |--- |--- |--- |
|CCC |++ |--- |--- |--- |--- |--- |--- |
|DDD |++ |--- |--- |--- |--- |--- |--- |

別途、日付セル（2桁日付が表示：C2に配置）があります

シート2:(名前以外の数字の列は、2桁表記の日付（文字列）です)
|名前|01 |02 |03 |04 |05 |06 |
|AAA |S-1 |S-2 |(null)|S-2 |(null)|S-2 |
|BBB |S-3 |(null)|S-1 |S-2 |S-3 |(null)|
|CCC |(null)|S-1 |(null)|S-2 |S-1 |(null)|
|DDD |(null)|(null)|S-1 |S-2 |S-3 |S-2 |

シート3:
|シフト名|列1|列2|列3|列4|列5|列6|
|S-1 |〇 |〇 |〇 |× |× |〇 |
|S-2 |× |× |× |〇 |〇 |〇 |
|S-3 |〇 |〇 |× |〇 |× |× |

上記を以下（①～③）のように使用したいと思っております

①シート1の日付とシート2の数字列を突き合わせ、そこでの各自のシフト状況を取り、
シート1の「出勤」に出力する

※この時点では、以下を想定しております（日付は[02]を指定）

シート1に以下が出力
|名前|出勤 |シフト1|シフト2|シフト3|シフト4|シフト5|シフト6|
|AAA |S-2 |--- |--- |--- |--- |--- |--- |
|BBB |(null) |--- |--- |--- |--- |--- |--- |
|CCC |S-1 |--- |--- |--- |--- |--- |--- |
|DDD |(null) |--- |--- |--- |--- |--- |--- |

②出勤に出力された値とシート3の「シフト名」列を突き合わせ、「列1」～「列6」の値を
シート1の「シフト1」～「シフト6」へ出力する

※この時点では、以下を想定しております

|名前|出勤 |シフト1|シフト2|シフト3|シフト4|シフト5|シフト6|
|AAA |S-2 |--- |--- |--- |〇 |〇 |〇 |
|BBB |(null) |--- |--- |--- |--- |--- |--- |
|CCC |S-1 |〇 |〇 |〇 |--- |--- |〇 |
|DDD |(null) |--- |--- |--- |--- |--- |--- |

③出勤のない人を非表示とする

※最終時点では、以下を想定しております

|名前|出勤 |シフト1|シフト2|シフト3|シフト4|シフト5|シフト6|
|AAA |S-2 |--- |--- |--- |〇 |〇 |〇 |
|CCC |S-1 |〇 |〇 |〇 |--- |--- |〇 |

③に関しては、以下のコードで達成できたのですが、他の個所の書き方がわかりませんでした。
申し訳ございませんがお分かりになられる方、ご教授願います

'対象外のユーザーは非表示
Application.ScreenUpdating = False

For Rw = 13 To 25
If Range("D" & Rw) = "" Then
Rows(Rw).EntireRow.Hidden = True
End If
Next
Application.ScreenUpdating = True

（上から、sheet1・sheet2・skeet3）
①sheet2のD5の値とsheet2の4行目の値を突き合わせる
②突き合わせた結果のsheet2の縦列（例：23日の場合、sheet2の23日の7～19行目）をsheet1のD13～d20に貼る
③shhet1のD13～d20で入力されている値とsheet3のB列を突き合わせて、一致した個所のsheet3のD～V列をsheet1のE～Xに貼る

行動規範の内容に同意します

回答1件

ベストアンサー

こんな感じでどうでしょうか。

VBA
1Sub sample()
2    
3    Dim sh1 As Range, sh2 As Range, sh3 As Range
4    Set sh1 = Sheet1.UsedRange  '表の範囲となるよう適宜修正
5    Set sh2 = Sheet2.UsedRange  '
6    Set sh3 = Sheet3.UsedRange  '
7    
8    With Application.WorksheetFunction
9    
10        Dim strDate As String
11        Dim co, ro
12        Dim i, j
13        Dim shift
14        
15        strDate = InputBox("日付を入力", , "02")
16        
17        co = .Match(strDate, .Index(sh2, 1, 0), False)
18        
19        For i = 2 To sh1.Rows.Count
20            
21            shift = sh2.Item(i, co).Value
22            
23            If shift = "" Then
24                sh1.Item(i, 2).EntireRow.Hidden = True
25            Else
26                ro = .Match(shift, .Index(sh3, 0, 1), False)
27                
28                For j = 1 To sh3.Columns.Count
29                    If Not sh3.Item(ro, j) = "×" Then sh1.Item(i, j + 1) = sh3.Item(ro, j)
30                Next
31            End If
32        Next
33    End With
34End Sub
35

追記：後から示されたやりたいことに沿って修正し、コメントも加えました。

VBA
1Sub sample2()
2    
3    '日付を取得
4    Dim strDate As String
5    strDate = Sheet1.Range("D5").Value
6
7    '各シートの表の範囲を取得
8    Dim sh1 As Range, sh2 As Range, sh3 As Range
9    Set sh1 = Sheet1.Range("C13:X20")
10    Set sh2 = Sheet2.Range("C4:AZ19")
11    Set sh3 = Sheet3.Range("D4:V8")
12
13    With Application.WorksheetFunction
14
15        Dim sh2Row, sh2Col, sh3Row
16        Dim i, j
17        Dim shift
18        
19        '日付からSheet2の列を取得
20        sh2Col = .Match(strDate, .Index(sh2, 1, 0), False)
21        
22        'Sheet1の各行を順次処理
23        For i = 1 To sh1.Rows.Count
24
25            'Sheet1の氏名からSheet2の行を取得し、シフトパターンを取得
26            sh2Row = .Match(sh1.Item(i, 1), .Index(sh2, 0, 2), False)
27            shift = sh2.Item(sh2Row, sh2Col).Value
28
29            If shift = "" Then
30                'シフトがない場合は行を非表示
31                sh1.Item(i, 2).EntireRow.Hidden = True
32            Else
33                'シフトが入っている場合はSheet3から該当シフトパターンの行を取得
34                sh3Row = .Match(shift, .Index(sh3, 0, 1), False)
35                
36                'Sheet3からSheet1に転記
37                For j = 1 To sh3.Columns.Count
38                    sh1.Item(i, j + 1) = sh3.Item(sh3Row, j)
39                Next
40            End If
41        Next
42    End With
43End Sub
44