VBA Match&Offset関数について

Question

VBA初心者です。
色々ネットで調べながら作業を行っておりますが、行き詰ってしまったため質問させて頂きたく思います。

わかりやすく書くため、箇条書きにさせて頂きます。

①１つのブックに２つのシートがある（案件ベース・個人ベース）
②個人ベースのスタッフ名を基準に案件ベースより該当する案件（B列にあるNo.）を抽出したい（１日～３１日まで）
③検索対象名がない日付には"休”の文字を転記

調べた結果Match・Offset関数を使うことはわかり、色々と組んでみたのですがエラーばかりで
歯が立ちませんでした。。。

ループさせるのは後で組込もうと思い、簡潔にと一つのセル・スタッフ名に対して作ってもダメでした。
下記にそのVBAを一応載せておきますのでそこに対してのご指摘でも、全然ダメ！こうやるの！と、一からのご教授でも問いませんのでお力添え宜しくお願い致します。

-----------
Sub シフト表≪個人ベース≫()
    
    '使用シートの設定
    Dim sh1, sh2 As Worksheet

    Set sh1 = Worksheets("個人ベース原紙")
    Set sh2 = Worksheets("案件ベース原紙")

    
    
   With sh1
    Dim 結果 As Double
    Dim i As Long
    
    i = 6 '個人ベースのF列
    結果 = sh1.Cells(6, i)


    
        結果 = Application.WorksheetFunction.Offset(sh2.Range("I5"), _
        Application.WorksheetFunction.Match(sh2.Range("C6"), sh1.Clumns("I"), 0) - 1, -7, 1, 1)
    
    End With

End Sub

GooUserラック · Accepted Answer

No.6 修正（いろいろと最適化してみました。No.6 でも一応動きます）

Sub シフト表≪個人ベース≫()

Dim S_Row As Long, S_Col As Long
Dim A_Row As Long, A_Col As Long
Dim T_Key As String
Dim S_Dic As Object 'スタッフ名⇒行番号対応辞書

Set S_Dic = CreateObject("Scripting.Dictionary")
　Sheets("個人ベース原紙").Select
　Range(Cells(6, 1), Cells(Rows.Count, Columns.Count)).ClearContents
　S_Row = 6
　With Sheets("案件ベース原紙")
　　For A_Col = 9 To 39
　　　Cells(4, A_Col - 3).Value = .Cells(4, A_Col).Value
　　　Cells(5, A_Col - 3).Value = .Cells(5, A_Col).Value
　　　For A_Row = 6 To .Cells(Rows.Count, A_Col).End(xlUp).Row
　　　　T_Key = .Cells(A_Row, A_Col).Value
　　　　If T_Key <> "" Then
　　　　　If S_Dic.Exists(T_Key) Then
　　　　　　Cells(S_Dic.Item(T_Key), A_Col - 3) = .Cells(A_Row, 2).Value
　　　　　Else
　　　　　　S_Dic.Add T_Key, S_Row
　　　　　　Cells(S_Row, 2).Value = S_Row - 5
　　　　　　Cells(S_Row, 3).Value = T_Key
　　　　　　Cells(S_Row, A_Col - 3) = .Cells(A_Row, 2).Value
　　　　　　S_Row = S_Row + 1
　　　　　End If
　　　　End If
　　　Next
　　Next
　End With
　Set S_Dic = Nothing
'↓「休」を入れる処理
　For S_Col = 6 To Cells(4, Columns.Count).End(xlToLeft).Column
　　For S_Row = 6 To Cells(Rows.Count, 2).End(xlUp).Row
　　　If Cells(S_Row, S_Col).Value = "" Then Cells(S_Row, S_Col).Value = "休"
　　Next
　Next
'↑「休」を入れる処理

End Sub

GooUserラック · Answer

以下のような物はいかがでしょうか？

※「個人ベース原紙」シートの６行目以降はクリアされるので「No.」「スタッフ名」などの事前入力不要です。
※「休」の文字ですが、使わないか「－」のようなあまり目立たないものにした方が見やすいです。使わな場合は「'↓「休」を入れる処理」～「'↑「休」を入れる処理」を丸々削除してください。

Sub シフト表≪個人ベース≫()

'使用シートの設定
Dim sh1 As Worksheet, sh2 As Worksheet
Dim S_Row As Long, S_Col As Long, S_End As Long
Dim A_Row As Long, A_Col As Long
Dim T_Key As String
Dim S_Dic As Object 'スタッフ名⇒行番号対応辞書

　Set sh1 = Worksheets("個人ベース原紙")
　Set sh2 = Worksheets("案件ベース原紙")
　Set S_Dic = CreateObject("Scripting.Dictionary")
　sh1.Select
　With sh1.UsedRange
　　Range(Cells(6, 2), Cells(.Rows(.Rows.Count).Row, .Columns(.Columns.Count).Column)).ClearContents
　End With
　S_Row = 6
　With sh2
　　For A_Col = 9 To 39
　　　Cells(4, A_Col - 3).Value = .Cells(4, A_Col).Value
　　　Cells(5, A_Col - 3).Value = .Cells(5, A_Col).Value
　　　For A_Row = 6 To .Cells(Rows.Count, A_Col).End(xlUp).Row
　　　　T_Key = .Cells(A_Row, A_Col).Value
　　　　If T_Key <> "" Then
　　　　　If S_Dic.Exists(T_Key) Then
　　　　　　Cells(S_Dic.Item(T_Key), A_Col - 3) = .Cells(A_Row, 2).Value
　　　　　Else
　　　　　　S_Dic.Add T_Key, S_Row
　　　　　　Cells(S_Row, 2).Value = S_Row - 5
　　　　　　Cells(S_Row, 3).Value = T_Key
　　　　　　Cells(S_Row, A_Col - 3) = .Cells(A_Row, 2).Value
　　　　　　S_Row = S_Row + 1
　　　　　End If
　　　　End If
　　　Next
　　Next
　End With
'↓「休」を入れる処理
　S_Col = 6
　S_End = Cells(Rows.Count, 2).End(xlUp).Row
　Do While Cells(4, S_Col).Value <> ""
　　For S_Row = 6 To S_End
　　　If Cells(S_Row, S_Col).Value = "" Then Cells(S_Row, S_Col).Value = "休"
　　Next
　　S_Col = S_Col + 1
　Loop
'↑「休」を入れる処理

End Sub

tom04 · Answer

こんばんは！

コードは詳しく見ていません。
①～③を勝手に解釈して・・・

Sub Sample1()
　Dim i As Long, j As Long
　Dim wS As Worksheet
　Dim c As Range
 
　　Set wS = Worksheets("案件ベース")
　　　With Worksheets("個人ベース")
　　　　For i = 6 To .Cells(Rows.Count, "C").End(xlUp).Row
　　　　　For j = wS.Range("I4").Column To wS.Cells(4, Columns.Count).End(xlToLeft).Column '//←「案件ベース」シートのI列～4行目の最終列まで
　　　　　　Set c = wS.Columns(j).Find(what:=.Cells(i, "C"), LookIn:=xlValues, lookat:=xlWhole)
　　　　　　　If Not c Is Nothing Then
　　　　　　　　.Cells(i, j - 3) = wS.Cells(c.Row, "B")
　　　　　　　Else
　　　　　　　　.Cells(i, j - 3) = "休"
　　　　　　　End If
　　　　　Next j
　　　　Next i
　　　End With
End Sub

こんな感じではどうでしょうか・m(_ _)m

GooUserラック · Answer

「案件ベース」日ごとの欄ですが１セル一人でしょうか？
F列に人数の欄がある所から数人入る可能性があるのかと思われます。
その場合のセパレーターは何になりますか？

GooUserラック · Answer

「案件ベース」シートから「個人ベース」シートへ転送ですよね。
「Match・Offset」は使わないといけないのでしょうか？
（個人的に他で代用出来て不便でもないのでほぼ使ったことが有りません）

GooUserラック · Answer

大変申し訳ございません「 https://oshiete.goo.ne.jp/qa/11459307.html 」の「No.6」へのお礼に対しての回答になります。

「If S_ERow <= 5 Then Exit Sub」の１行を削除して下さい。
元々、張付け先の行数が不明だったので対策用の物です。6行目から開始という事なので不要なだけでなく、バグを生んでしまいました。お詫びいたします。

fujillin · Answer

こんにちは

お求めの回答ではないかも知れませんが、VBAでシート関数を使いまくるのなら、関数で解決する方が手っ取り早いのではないかと・・・

一例として、ご提示の「個人ベース」シートのF6セルに
　=IFERROR(INDEX(案件ベース原紙!$B:$B,MATCH($C6,案件ベース原紙!I:I,0)),"")
という関数を代入して、右、下方向に必要な範囲までフィルコピーでできるものと思います。

※ 担当者名は検索していますが、日付は必ず順に並んでいるものと仮定して単純な位置差から算出しています。

なお、VBAで行わなければならない事情がある場合には、「上記の式をVBAから設定する」という裏技も考えられます。
　Worksheets("○〇").Range("範囲").FormulaLocal = "関数式"
の1行で済んでしまいます。
実行後に関数をシートに残しておきたくないという場合は、
　Worksheets("○〇").Range("範囲").Value = Worksheets("○〇").Range("範囲").Value
とすることで、関数ではなく値として固定することが可能です。
大雑把に言えば、上記の2行でほとんどの内容が実行できるのではないかと思います。