Excelの最終列までの転記について

Question

Execl 2010を利用してます。VBAのコードついてご教示お願いします。

sheet管理のセルA5に本日の日付があります。

sheet管理のセルA8から、従業員の名前があります。

sheetシフトに、今月の従業員の勤務時間があります。

sheetシフトのセルC1～AG1には、1/1　1/2　1/3　と日付があります。
sheetシフトのセルB2から従業員の氏名が入力されています。（例えば、セルB13まで等）


sheetシフトのセルC2～AG2には勤務時間が入力されています。（従業員のが13名ならC2～AG13）



やりたいことは、

sheet管理のセルA5の日付と、sheetシフトのセルC1～AGの日付が一致したときに、
sheetシフトの勤務時間（例えば、C2～C13まで）をsheet管理のB8へ転記したいのです。

従業員は月ごとに人数が変わるので、最終列までとしたいのです。

WEBで、Excel　最終列　転記等で検索しましたが、正解にたどり着けません。


sheet管理のセルA5の日付と、sheetシフトのセルC1～AGの日付が一致したときに、⇒これがどのようなコードかわかりません。


丸投げで本当に申し訳ないのですが、コードをご教示していただけないでしょうか？

tatsu99 · Accepted Answer

補足要求です。
１）sheetシフトのセルC1は、必ず1日の日付が設定されてますか。(1/1,2/1,3/1等）
そうであれば、2日は、C4のセルを参照すれば良いことになります。（C4のセルの日付は確認せずに決定出来ます）

２）sheet管理のA5に本日の日付がありますが、マクロを実行したとき、月がずれている可能性がありますか？
例　マクロ実行時、A5=2/3で、sheetシフトのC1が1/1のケース

３）sheet管理の従業員の並びとsheetシフトの従業員の並びは一致していますか。
それとも、一致していませんか。又、sheet管理の従業員の人数とsheetシフトの従業員の人数は必ず一致している
と考えてよいですか。
例
sheet管理 
　　　A列
8行　山田太郎
9行　山田花子
10行　小田切ジョー

sheetシフト 
　　　B列
２行　小田切ジョー
３行　山田花子
のようなケースはありますか。

tatsu99 · Answer

sheetシフトのC1は1日（ついたち）の日付が設定されている前提です。
（2月になったらC1に2/3が設定されていることは想定していません。2月は2/1の日付が設定されているものとします）
sheet管理の従業員の並びとsheetシフトの従業員の並びが一致しなくても良いようにしてあります。
（名前で紐づけますので、名前は完全に一致させてください。山田ハナコと山田ﾊﾅｺは不一致の扱いとなります）
以下のようになります。標準モジュールへ登録してください。
--------------------------------------------
Option Explicit
Public Sub 勤務時間転記()
    Dim sh1 As Worksheet
    Dim sh2 As Worksheet
    Dim dicT As Object  '連想配列
    Dim row1 As Long
    Dim row2 As Long
    Dim MaxRow1 As Long
    Dim MaxRow2 As Long
    Dim colno As Long   'sheetシフトの列番号
    Dim name As String
    Set dicT = CreateObject("Scripting.Dictionary") ' 連想配列の定義
    Set sh1 = Worksheets("管理")
    Set sh2 = Worksheets("シフト")
    MaxRow1 = sh1.Cells(Rows.Count, "A").End(xlUp).Row 'sheet管理 最終行を求める
    MaxRow2 = sh2.Cells(Rows.Count, "B").End(xlUp).Row 'sheetシフト 最終行を求める
    'sheet管理の従業員名と行番号を記憶する
    For row1 = 8 To MaxRow1
        dicT(sh1.Cells(row1, "A").Value) = row1
    Next
    'sheetシフトの列番号を取得
    colno = Day(sh1.Range("A5").Value) + 2
    'sheetシフトの勤務時間を転記
    For row2 = 2 To MaxRow2
        name = sh2.Cells(row2, "B").Value
        If dicT.exists(name) = True Then
            '該当氏名のB列へ転記
            row1 = dicT(name)
            sh1.Cells(row1, "B").Value = sh2.Cells(row2, colno).Value
        Else
            MsgBox (name & "は管理に存在しません")
        End If
    Next
    MsgBox ("転記完了")
End Sub
------------------------------------

Excelの最終列までの転記について

補足要求です。

sheetシフトのC1は1日（ついたち）の日付が設定されている前提です。

似たような質問が見つかりました

関連するカテゴリからQ&Aを探す

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング