指定した年月日でデータを読み込み、上書き修正するやり方 (VBA,Excel)

Question

VBAで今度は勤怠管理システムを作らなければならなくなったのですが
年月日を指定してその日に登録した出退勤時間を呼び出して数字を修正することは可能なのでしょうか・・？

下記画像が出退勤時間を登録する画面です(シートはApplication.Visible = False　で非表示状態）

生年月日をプルダウンで選んで読み込みボタンを押すと
出退勤、休憩時間がそれぞれに表示されるようにしたいのですが・・・。

※登録した時間はシートの方に追加されていきます。

一番先頭のシートを・・・とか、シート名で指定して・・・なら方法がありますが
上記のようなやり方はあるのでしょうか。

近いやり方等でも教えていただけると幸いです。

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

該当のソースコード

Private Sub cb_touroku_Click()                      '登録ボタン
    Dim tgtRow As Long
    tgtRow = Cells(Rows.Count, 1).End(xlUp).Row
    tgtRow = tgtRow + 1
    
    
    With Sheet3　　　　　　　　　　　　　　　　　　　　　　　’プルダウンで数字を選択します
        .Cells(tgtRow, 1).Value = Me.cb1.Value　　　　'2021年のみ
　　　　 .Cells(tgtRow, 2).Value = Me.cb2.Value          '月選択
        .Cells(tgtRow, 3).Value = Me.cb3.Value        '1~31　　　日
        .Cells(tgtRow, 4).Value = Me.cb4.Value　　　　　'1~24　　　時間
        .Cells(tgtRow, 5).Value = Me.cb5.Value　　　　　　'1~00   分
        .Cells(tgtRow, 6).Value = Me.cb6.Value　　　　　　'1~24　　　時間
        .Cells(tgtRow, 7).Value = Me.cb7.Value　　　　　　'1~00   分
        .Cells(tgtRow, 8).Value = Me.cb8.Value           '1~24　　　時間
        .Cells(tgtRow, 9).Value = Me.cb9.Value           　'1~00   分
        .Cells(tgtRow, 10).Value = Me.cb10.Value         '1~24　　　時間
        .Cells(tgtRow, 11).Value = Me.cb11.Value       '1~00   分
         
    End With
    
    MsgBox "登録しました"
       
End Sub

Private Sub UserForm_Initialize()
    With cb1
        .AddItem "2021"
    End With
    With cb2
        .AddItem "1"             
        .AddItem "2"
        .AddItem "3"
        .AddItem "4"
        .AddItem "5"
        .AddItem "6"
        .AddItem "7"
        .AddItem "8"
        .AddItem "9"
        .AddItem "10"
        .AddItem "11"
        .AddItem "12"
    End With

    With cb3
        .AddItem "1"
        .AddItem "2"
        .AddItem "3"
        .AddItem "4"
        .AddItem "5"
        .AddItem "6"
        .AddItem "7"
        .AddItem "8"
        .AddItem "9"
        .AddItem "10"
        .AddItem "11"
        .AddItem "12"
        .AddItem "13"
        .AddItem "14"
        .AddItem "15"
        .AddItem "16"
        .AddItem "17"
        .AddItem "18"
        .AddItem "19"
        .AddItem "20"
        .AddItem "21"
        .AddItem "22"
        .AddItem "23"
        .AddItem "24"
        .AddItem "25"
        .AddItem "26"
        .AddItem "27"
        .AddItem "28"
        .AddItem "29"
        .AddItem "30"
        .AddItem "31"
    End With

※以下、cb4～も同様の記述

試したこと

補足情報（FW/ツールのバージョンなど）

Answer 1

私の思い付きを画像にしました。参考になれば、






それから＜年月日を指定してその日に登録した出退勤時間を呼び出して数字を修正することは可能なのでしょうか・・？＞については　URL記載します
http://home.att.ne.jp/zeta/gen/excel/c03p04.htm
「エクセル大事典」武藤さまより抜粋
タイトル「シートで簡易データベース」の中で　「各項目の値
を変更し　Sheetｓ（”シート名”）.UserRange = WrkRange
とすれば、変更された値が一気に元の場所に書き込まれます・・
とあります。参考にしてください

Comments

[milk1218]

URLもご提示いただきありがとうございます！！
画像付きでとても分かりやすいです・・・！

Answer 2

素人なりに考えてみました。
cb1から順にcb3までプルダウンで選んでいってcb3で検索して、該当があればテキストボックス表示に行番号となるTarget、該当がなければ「新規」を表示するようにしてみました。この区別によって、末尾の次に追加処理、行番号の更新処理をすればよいと思います。また、オーカスを移すbuDummyボタンを作っています。参考になればと思います。

Private FLG As Boolean

Private Sub cb1_DropButtonClick()
Call ComboClear(2)
End Sub

Private Sub cb1_Click()
Me.buDummy.SetFocus
End Sub

Private Sub cb2_DropButtonClick()
Call ComboClear(3)
End Sub

Private Sub cb2_Click()
Me.buDummy.SetFocus
End Sub

Private Sub cb3_DropButtonClick()
If Not FLG Then
Call ComboClear(3)
End If
FLG = False
End Sub

Private Sub cb3_Click()
Call Seach
FLG = True
Me.buDummy.SetFocus
End Sub

Private Sub Seach()
Dim Sh As Worksheet
Dim myData As Variant
Dim I As Long
Dim J As Long
Dim Target As Long

If cb1.Value = "" Or cb2.Value = "" Or cb3.Value = "" Then
    Exit Sub
End If

For Each Sh In ThisWorkbook.Worksheets
    If Sh.Name = cb2.Value Then

        myData = Sh.UsedRange.Value
        Target = 0
        For I = 2 To UBound(myData, 1)
            If CompareVal(cb1.Value) = CompareVal(myData(I, 1)) And _
               CompareVal(cb2.Value) = CompareVal(myData(I, 2)) And _
               CompareVal(cb3.Value) = CompareVal(myData(I, 3)) Then
                If Target = 0 Then
                    Target = I
                Else
                    Target = -1
                End If
            End If
        Next I

        Select Case True
        Case Target = 0
            Me.表示.Value = "新規"
            MsgBox "該当者はいません。"
        Case Target = -1
            Me.表示.Value = ""
            MsgBox "重複しています。"
        Case Target > 1
            Me.表示.Value = Target
            With Sh
                cb4.Value = .Cells(Target, 4).Value
                cb5.Value = .Cells(Target, 5).Value
                cb6.Value = .Cells(Target, 6).Value
                cb7.Value = .Cells(Target, 7).Value
                cb8.Value = .Cells(Target, 8).Value
                cb9.Value = .Cells(Target, 9).Value
                cb10.Value = .Cells(Target, 10).Value
                cb11.Value = .Cells(Target, 11).Value
            End With
        Case Else
            Me.表示.Value = ""
            MsgBox "不明なトラブル"
        End Select

    End If
Next Sh

End Sub

Function CompareVal(ByVal myVal As Variant) As String
Dim BUF As String

BUF = myVal
CompareVal = Right("0000" & BUF, 4)

End Function

Private Sub ComboClear(ByVal StartNum As Long)
Dim I As Long

For I = StartNum To 11
    Me("cb" & I).Value = ""
Next I

End Sub

Comments

[milk1218]

ご丁寧にありがとうございます！！
参考にさせていただきます・・・！！

Answer 3

考え方を。

ソースコードだと、「月」ごとにデータが別れているようには見えませんが、それはさておき、

○検索時
・指定した「月」から対象シートを特定（シート名を「年」も考慮するのであれば「年」も対象）
・指定した日付の行を検索
・以下のようにして、現在の値を表示。

Me.cb1.Value = Cells(tgtRow, 1).Value

○登録時
現在は、表の一番下に追記するようにしていますが、検索後修正した場合は、検索時の行番号を利用して値を上掛けばよいのでは。
ただし、新規に登録する時と処理を分ける必要があります。

Comments

[milk1218]

月ごとにデータ分けるようにするのはまだ出来ていませんね・・！

分かりやすくご説明いただきありがとうございます！！