[[20190904125443]]　『勤務表　５日締めと末締めファイルを1回で作成しａx（ひまわり）　ページの最後に飛ぶ

『勤務表　５日締めと末締めファイルを1回で作成したい』（ひまわり）

現在、５日締めと末締めのエクセルファイルがあり全く同じ内容を
書いて社内に提出しています。

末締め分は、月末で終わっていて５日締めようにもここに書いたことと
同じことを再度入力しています。１日～５日分が増えているだけです。
1つのエクセルファイルで、月末締めと５日締めを完結することが出来たら
嬉しいのですが何か良い方法はありませんか？

＜使用 Excel：Excel2016、使用 OS：Windows10 ＞

こんにちは　＾＾
一つのシートに全て入力しておいて日付で範囲を指定してフイルター詳細
とかででコピーしてはどうでせう。←マクロにしておけばもっと便利ですね
m(_ _)m
（隠居じーさん） 2019/09/04(水) 13:52

隠居じーさん

一つのシートに全てを入力と言うのは一年分を一つのシート
にする感じですか？

マクロ・・・。

未知の世界ですが、マクロで実現できるのでしょうか？
（ひまわり） 2019/09/07(土) 11:51

 作業のイメージがキッチリとつかめてないですが、

  ５日締めを作る時は、月末分に１日～５日分を増やして、
  [ファイル] →[名前を付けて保存］と進んで、
 「５日締め」用のファイル名にするだけでいいんじゃないですか？

 そうは行かない場合、もう少しそちらの状況を詳しく説明して貰えませんか。

（半平太） 2019/09/07(土) 12:02

半平太　様

５日締めを作る時は、月末分に１日～５日分を増やして、
→これは、めんどくさいです。
現時点で、会社が用意した末締めと５日締めのエクセルファイルがあるので
それを使う方が良いです。
勤務表なので、当日の勤務時間の合計と一か月分の勤務時間の合計の式が
組まれています。
たぶん、社内の人がネットで落としたものを会社として使用してます。
入社時期によって締め日がまちまちです。
（全国に、散らばってもいます。）
なので、私の場合は末締めと５日締めを提出しなければいけません。
エクセルファイル２つありそれぞれに同じようを記載して５日締めは１～５日分だけは
５日締めの方にだけ記載します。
でも、同じことを２回書いているってそもそも無駄ですよね。
会社も、分かっているようですがなかなか分かる人がおらず（分かる人が辞めてしまったので）
進んでいない状況です。
なので、個人的に作成してしまおうと思っています。
（ひまわり） 2019/09/07(土) 12:30

こんにちは　＾＾
ご説明の内容から推測すると

末　締　　　　９／１　～　９／３０
５日締　　　　９／１　～　１０／５
　
の日別勤怠を１０／５を過ぎてから、別ｂｏｏｋで纏める、ではないの
でしょうか。
もしそうでしたら、半平太さんのご案内の通り、最初は１０／１分を入
力する前に、にファイル名【末締】で保存し、１０／５日を超える、日
に１０／１～１０／５分を入力後【５日締】のファイル名でそのまま保
存すれば、二回入力は避けられるかと、違っていましたら、相違点をさ
らに詳しくご説明いただくと、多数、アドバイス、回答等、有るかもし
れません。　←　多分　＾＾；　でわ

（隠居じーさん） 2019/09/07(土) 13:50

隠居じーさん

末締めは、９月１日～９月３０日ですが
５日締めは、９月６日～１０月５日までです。
（ひまわり） 2019/09/07(土) 16:13

はい。そぉなのですね。で、具体的には数式が有る箇所
以外はどのように入力されているのですか。
タイムカード、見ながら
末締めに直接書き込む。
５締めに直接書き込む。
でしょうか
それとも
他部署から月単位の勤怠情報がエクセルで送られてきて
、それを手入力で、再入力されているのでしょうか。そ
れと具体的なシート名、セル番地が解るような、表形式
で（同じパターンなら）５～６件でもよいので、個人情
報は、従業員Ａ、Ｂ～とかで、ご提示いただけると、具
体的な回答、アドバイスが、受けやすいかと思います。
m(_ _)m

（隠居じーさん） 2019/09/07(土) 17:24

追加質問　＾＾；
部署の方末締めと５日締め、全員分では無くて、ひまわりさん　個人の勤怠を、末締めと５日締めで
提出されるのですか。　←　おのずと　表形式が変わってくると思いますので。
（隠居じーさん） 2019/09/07(土) 17:34

 提出用のシートがどのようなものかわからないので、何とも言えませんが

 勤務データ入力用のシートを用意しておいて、通常はそれに入力しておいて
 提出時には、そこから必要範囲を　締日に合わせてコピペすればいいと思いますが
 はずしてますか？

（渡辺ひかる） 2019/09/07(土) 18:28

 こんにちは　＾＾　いや～　情報が詳細不明なので
恐怖の憶測と推測の、冗長なコードに　←　情報に関係ないだろ
（＾＾；。。。
きっともっとスマートな方法は有るかと思いますがマクロの便利さ等
お解り戴ける一助とでもなれば幸甚です、多分大的外れかも　m(_ _)m
Sheet1　Sheet2　Sheet3　以外のシートは削除されます。
必ずバックアップは取りましょう。

 使用情報　シート名　Sheet1

 Sheet1 テスト使用情報

     |[A]    |[B] |[C]  |[D]     |[E] |[F]   |[G] |[H]
 [1] |日付   |出勤|退勤 |拘束時間|休憩|不就労|残業|深夜
 [2] |7月31日|8:10|19:39|11:29   |1:00|0:00  |3:29|0:00
 [3] |8月1日 |7:43|18:39|10:56   |1:00|0:00  |2:56|0:00
 [4] |8月2日 |7:33|19:30|11:57   |1:00|0:00  |3:57|0:00
 [5] |8月5日 |7:11|18:25|11:14   |1:00|0:00  |3:14|0:00
 [6] |8月6日 |8:04|19:17|11:13   |1:00|0:00  |3:13|0:00
 [7] |8月7日 |9:10|19:24|10:14   |1:00|0:00  |2:14|0:00
 [8] |8月8日 |9:45|19:48|10:03   |1:00|0:00  |2:03|0:00
 [9] |8月9日 |8:31|19:08|10:37   |1:00|0:00  |2:37|0:00
 [10]|8月12日|8:03|19:59|11:56   |1:00|0:00  |3:56|0:00
 [11]|8月13日|9:18|18:05|8:47    |1:00|0:00  |0:47|0:00
 [12]|8月14日|7:57|18:07|10:10   |1:00|0:00  |2:10|0:00
 [13]|8月15日|8:36|19:08|10:32   |1:00|0:00  |2:32|0:00
 [14]|8月16日|8:14|18:34|10:20   |1:00|0:00  |2:20|0:00
 [15]|8月19日|8:00|19:59|11:59   |1:00|0:00  |3:59|0:00
 [16]|8月20日|7:26|18:46|11:20   |1:00|0:00  |3:20|0:00
 [17]|8月21日|7:10|19:46|12:36   |1:00|0:00  |4:36|0:00
 [18]|8月22日|9:43|18:51|9:08    |1:00|0:00  |1:08|0:00
 [19]|8月23日|8:21|18:01|9:40    |1:00|0:00  |1:40|0:00
 [20]|8月26日|9:10|19:32|10:22   |1:00|0:00  |2:22|0:00
 [21]|8月27日|7:50|19:35|11:45   |1:00|0:00  |3:45|0:00
 [22]|8月28日|7:47|18:57|11:10   |1:00|0:00  |3:10|0:00
 [23]|8月29日|8:44|19:18|10:34   |1:00|0:00  |2:34|0:00
 [24]|8月30日|8:10|18:50|10:40   |1:00|0:00  |2:40|0:00
 [25]|9月2日 |8:10|18:35|10:25   |1:00|0:00  |2:25|0:00
 [26]|9月3日 |7:12|18:07|10:55   |1:00|0:00  |2:55|0:00
 [27]|9月4日 |7:20|19:16|11:56   |1:00|0:00  |3:56|0:00
 [28]|9月5日 |9:45|18:18|8:33    |1:00|0:00  |0:33|0:00
 [29]|9月6日 |8:11|18:45|10:34   |1:00|0:00  |2:34|0:00
 [30]|9月9日 |9:09|19:28|10:19   |1:00|0:00  |2:19|0:00
 [31]|9月10日|7:55|18:49|10:54   |1:00|0:00  |2:54|0:00

 Option Explicit
Sub OneInstanceOfAttendanceTable()
    Dim i As Long
    Dim Base As Range
    Dim Sm, WsNm
    Dim Fromd(1 To 2) As Date
    Dim Tod(1 To 2) As Date
    WsDelete
    Sm = Application.InputBox("処理年月を数値で入力", "V B A", Year(Date) & Month(Date) - 1, , , , , 1)
    If Sm = False Then Exit Sub
    Sm = Left(Sm, 4) & Chr(2) & Mid(Sm, 5)
    Fromd(1) = DateSerial(Split(Sm, Chr(2))(0), Split(Sm, Chr(2))(1), 1)
    Tod(1) = DateSerial(Year(Fromd(1)), Month(Fromd(1)) + 1, 0)
    Fromd(2) = DateSerial(Split(Sm, Chr(2))(0), Split(Sm, Chr(2))(1), 6)
    Tod(2) = DateSerial(Year(Fromd(1)), Month(Fromd(1)) + 1, 5)
    If Tod(2) >= Date Then
        MsgBox "５日締、締切日未到達です"
        Exit Sub
    End If
    WsNm = Array("Dumy", "末締", "５日締")
    For i = 1 To 2
        Worksheets("Sheet1").Copy Worksheets(1)
        With ActiveSheet
            .Name = WsNm(i)
            Set Base = .Cells(1).CurrentRegion
            .Cells(1, 10).Resize(, 2) = "日付"
            .Cells(2, 10).Resize(, 2) = Array(">=" & Fromd(i), "<=" & Tod(i))
            Base.AdvancedFilter 2, .Range("J1:K2"), .Cells(1, 15)
            .Range("A:N").Delete
        End With
    Next
    Set Base = Nothing
End Sub
Private Sub WsDelete()
    Dim i As Long
    Application.DisplayAlerts = False
    For i = ThisWorkbook.Worksheets.Count To 1 Step -1
        If Worksheets(i).Name <> "Sheet1" And _
           Worksheets(i).Name <> "Sheet2" And _
           Worksheets(i).Name <> "Sheet3" Then
           Worksheets(i).Delete
        End If
    Next
    Application.DisplayAlerts = True
End Sub

 14:20　一部、修正　m(_ _)m .FilterMode = False
エラーにはなりませんが、確か調べるだけで設定は出来ない様な。
というか、↑コードではフイルターモードになっていないようです。？
なにげに使っていますが、勉強します。
（隠居じーさん） 2019/09/08(日) 13:49

＞５日締めと末締めのエクセルファイルがあり全く同じ内容を

フォーマット（セル位置）が異なっているため
データは同じでも、それぞれに入力しているということでしょうか。

（マナ） 2019/09/08(日) 15:01

隠居じーさん
上のコメントに、返信していなかったですね。
タイムカードとかは、ないので常に思い出しながら入力って感じですね。
明日、出社次第勤務表のフォーマットの詳細を提示でします。
個人の勤怠を、末締めと５日締めで提出しています。
コード、ありがとうございます。
シート名は、５日締，末締と変更されて書込みはされるのですが終了と共に
中身が消えてしまいます。
↓最終的にこのタイトルだけになってしまいます。
日付出勤退勤拘束時間休憩不就労残業深夜

マナ様

どちらも、フォーマットは同じです。
８月１日から始まっているか，８月６日から始まっているかの違いだけです。

（ひまわり） 2019/09/08(日) 15:49

追記

決まったフォーマットシートに対して書き込むことも可能ですか？？
（ひまわり） 2019/09/08(日) 15:54

 こんにちは　＾＾
＞＞中身が消えてしまいます。 
＞＞↓最終的にこのタイトルだけになってしまいます。 
＞＞日付 出勤 退勤 拘束時間 休憩 不就労 残業 深夜
 え～と、考えられる原因としては
１．Ａ列の日付情報がシリアル値ではない
２．Ａ列の項目名が【日付】ではない
３．指定した年月の情報が無い
４．Sheet1の情報が提示させていただいた情報の位置と違っている
等、が考えらられます。ご確認、お願いいたします。
では　m(_ _)m
＞＞決まったフォーマットシートに対して書き込むことも可能ですか？？
読込、書込み双方のセル番地対応（どのセルをどのセルへ）がわかれば可能
だと思いますです。
（隠居じーさん） 2019/09/08(日) 16:08

隠居じーさん

今は、上のサンプル勤務表のデータをエクセルデータにして
マクロを実行しています。
（ひまわり） 2019/09/08(日) 16:29

 こんばんは　＾＾　はい　。。。
こちらでも同様にしています。大変済みません
ｗ。。。消えていますね
原因究明中　(◎_◎;)
解決出来次第再度アップ致します。
ま！なんとでも出来ますので。。。。
m(__)m

（隠居じーさん） 2019/09/08(日) 16:50

作成したい勤務表のデータが見つかりました。

   B      D     F  G    H   I J  K     L    M    N  O   P
  |2019| |年| | 9|月度|氏名|〇〇〇〇|     |部署|           |

    B                                                                       P
 5 |月|日|曜|休日|区分|出勤|退社|就業|早出残|普通残|深夜残|休出|遅刻||早退|備考|
    8  6  火　
　　　 7  水
　　　 8  木
 ※日付入力領域は、３６行目まで

 ※休日：１の時区分：休日，休日：空白の時区分：空白
 ※出勤，退勤は、手入力
 ※就業から早退までは、マクロで計算式が入っているみたいです。
　　（入力すると自動的に入力されます）
 ※B37セル（Bセル～Hセルまで結合）：「合計」
 ※Iセル～Oセルまで各合計が入ります。
 ※P３８セル：「担当確認印」

（ひまわり） 2019/09/08(日) 17:12

 こんばんは　＾＾
なんとなく全体の輪郭の様なものが解ってきたような気がいたします。
↑の私のコードはあまりお役に立てない様なので没にしておいてくだ
さい。(現在バグッてますし)　(￣▽￣)；多分日付条件の書き方だとは
思うのですが。。。m(_ _)m

＞＞※出勤，退勤は、手入力　　＋　日付

 だけエクセルに入力したものをベースに、５日、末、各シートの
日付に対応する出勤，退勤欄に転記する。
という事でしたら別途考えます、合わせて、他の方の回答もお待ちくださいね
でわ、少し時間がかかりそぉなので　←　私だけ　＾＾；。。。失礼致します。
m(_ _)m
（隠居じーさん） 2019/09/08(日) 17:56

フォーマットが同じなら、半平太さんの案でよいと思うのですが

＞→これは、めんどくさいです。

なぜ、↑なのかが、理解できません。

＞多分日付条件の書き方だと

見出しが一致していないだけです。

（マナ） 2019/09/08(日) 18:38

隠居じーさん

＞＞※出勤，退勤は、手入力　　＋　日付

 だけエクセルに入力したものをベースに、５日、末、各シートの
日付に対応する出勤，退勤欄に転記する。

 そんなイメージです。

 宜しくお願いします。
（ひまわり） 2019/09/08(日) 18:52

 >作成したい勤務表のデータが見つかりました。

 これを会社に提出しているのですよね？

 個人別に　一人　1シートなら、それぞれ　締め日が違っていると思いますので

 >全く同じ内容を 書いて社内に提出しています。

 というのはあり得ないと思いますが？

 月末には、月末締めだけ、5日以降には　5日締めだけを提出しているのではないのですか？

（渡辺ひかる） 2019/09/09(月) 09:18

8月1日〜8月31日の末締めと
8月6日〜9月5日の5日締めであれば、
8月6日〜31日は、末締めのデータと
出勤,退勤の、時間は、同じでなければ
いけません。
（ひまわり） 2019/09/09(月) 15:25

 こんにちは　＾＾　
諸先生方はきっと、どうせ、何処かに一度は入力しないといけないわけで、二回しろとは決して
云っておられないのではないかと、8月1日〜8月31日を一度入力すれば、あとは５日〆のときは
8月6日〜8月31日はコピーペーストで貼り付ければあと５日分だけ入力すればいいだけなのでは
と思います←この場合別の場所への下書き入力は必要が無いと思います。ま！運用面はさておき
マクロのお勉強という事で作ってみましたので。何かの足しにでも。m(_ _)m
当初アップさせていただいたコードの不具合ですが項目名の（日付）の後ろに半角スペースの
ゴミがあったのが原因でした。新作コード後ほどアップ致します。
（隠居じーさん） 2019/09/09(月) 16:50

 例えば　月末締めのAさんがいるとして

 月末締めの時にはAさんの　8/1-8/31　までのデータを提出すればよく
 5日締めの時にはAさんのデータは提出しない　と理解しているのですが

 違うんですか？

 >出勤,退勤の、時間は、同じでなければ いけません。

 同じデータなら　コピー　貼り付けすれば済むことだと思いますが
 それができない理由があるのでしょうか？

（渡辺ひかる） 2019/09/09(月) 16:58

 任意のフォルダを作成して現在ご使用の
末締め若しくは５日締めのＢＯＯＫをどちらか
片方（同じフォーマットとの事ですので）を
コピーして　AtBase.xlsm　と名前を変えて下さい
当該の書込をするシートを一番左端に移動するか
不都合が有るかもしれませんので下記の部分を
実際のシート名に変更してください。
Private Sub BookWriteSubMoveData　の
With Wb.Worksheets(1)　←　を
With Wb.Worksheets("実際のシート名")

 その後、保存してください 
 次に
新規ＢＯＯＫで名前は何でもよいので作成して今回提示させていただ
いたコードを貼り付け、実行して下さい。休日、区分については詳細
が解りませんでしたので何もしていません。でわ

 Sheet1　を勤怠入力に使用して保存してください。

 　　　　Ａ　　　　　　Ｂ　　　　　　Ｃ　　　　　Ｄ　　　
 　１　 日付 　 　　　出勤　　　　　退勤　　　　休日
 　２　１月１日　　　８：３０　　　１８：０１
 　３　１月２日　　　７：４５　　　１７：５５
 　４　１月３日　　　　　　　　　　　　　　　　　　   １
　　　　　　
 Option Explicit
Sub OneInstanceOfAttendanceTable02()
    Dim Bnm
    Dim Fromd(1 To 2)  As Date
    Dim Tod(1 To 2)    As Date
    Dim Base
    Dim t As Date
    t = Timer
    Bnm = Array("末締", "５日締")
    Pstart
    Accsept Fromd, Tod
    BookSet Bnm
    DataSet Base
    BookWrite Base, Bnm, Fromd, Tod
    Pend
    Erase Base
    MsgBox Format(Timer - t, "0.0") & "秒　完了"
End Sub
Private Sub BookWrite(ByVal Base As Variant, ByVal Bnm As Variant, ByVal Fromd As Variant, ByVal Tod As Variant)
    Dim i             As Long
    Dim Var           As Variant
    Dim Btbl          As Variant
    For Each Var In Bnm
        Select Case Var
            Case "末締"
                Btbl = BookWriteSubDataDiv(Base, Fromd(1), Tod(1))
                If TypeName(Btbl) = "Boolean" Then
                    Erase Base
                    MsgBox "書込み件数オーバー : " & Chr(13) & Var
                    End
                End If
                BookWriteSubMoveData Var, Btbl
            Case "５日締"
                Btbl = BookWriteSubDataDiv(Base, Fromd(2), Tod(2))
                If TypeName(Btbl) = "Boolean" Then
                    Erase Base
                    MsgBox "書込み件数オーバー : " & Chr(13) & Var
                    End
                End If
                BookWriteSubMoveData Var, Btbl
        End Select
    Next
    Erase Btbl
End Sub
Private Sub BookWriteSubMoveData(ByVal Bnm As String, ByVal Btbl As Variant)
    Dim Wb            As Workbook
    Dim i             As Long
    Set Wb = Workbooks.Open(ThisWorkbook.Path & "\" & Bnm)
    With Wb.Worksheets(1)
        Intersect(.UsedRange, .Range("B:D"), .Range(.Rows(6), .Rows(36))).ClearContents
        .Range("B1") = Year(Btbl(1, 1))
        .Range("F1") = Month(Btbl(1, 1))
        For i = 1 To UBound(Btbl, 1)
            .Cells(i + 5, 2) = Month(Btbl(i, 1))
            .Cells(i + 5, 3) = Day(Btbl(i, 1))
            .Cells(i + 5, 4) = Btbl(i, 1)
            .Cells(i + 5, 4).NumberFormatLocal = "aaa"
            .Cells(i + 5, 7) = Btbl(i, 2)
            .Cells(i + 5, 8) = Btbl(i, 3)
        Next
        Intersect(.UsedRange, .Range("G:H"), .Range(.Rows(6), .Rows(36))).NumberFormatLocal = "h:m"
    End With
    Wb.Close True
    Set Wb = Nothing
End Sub
Private Function BookWriteSubDataDiv(ByRef Base As Variant, ByVal Fromd As Variant, ByVal Tod As Variant) As Variant
    Dim i             As Long
    Dim j             As Long
    Dim Y             As Long
    Y = 1
    For i = 1 To UBound(Base, 1)
        If Base(i, 1) >= Fromd And Base(i, 1) < Tod Then
            Worksheets("Sheet1").Cells(Y, "XEV").Resize(, UBound(Base, 2)) = WorksheetFunction.Index(Base, i, 0)
            Y = Y + 1
        End If
    Next
    BookWriteSubDataDiv = Worksheets("Sheet1").Cells(1, "XEV").CurrentRegion.Value
    Worksheets("Sheet1").Cells(1, "XEV").CurrentRegion.Delete
    If UBound(BookWriteSubDataDiv, 1) > 31 Then
        MsgBox "警告！情報が異常です、確認後再処理の必要が有ります"
        BookWriteSubDataDiv = False
    End If
End Function
Private Sub DataSet(ByRef Var As Variant)
    With ThisWorkbook.Worksheets("Sheet1")
        Var = Intersect(.UsedRange.Offset(1), .Range("A:D"), .Range(.Rows(2), .Rows(.UsedRange.Rows.Count)))
    End With
End Sub
Private Sub Accsept(ByRef Fromd As Variant, ByRef Tod As Variant)
    Dim Sm            As Variant
    Sm = Application.InputBox("処理年月を数値で入力", "V B A", Year(Date) & Month(Date) - 1, , , , , 1)
    If Sm = False Then End
    Sm = Left(Sm, 4) & Chr(2) & Mid(Sm, 5)
    Fromd(1) = DateSerial(Split(Sm, Chr(2))(0), Split(Sm, Chr(2))(1), 1)
    Tod(1) = DateSerial(Year(Fromd(1)), Month(Fromd(1)) + 1, 0) + 1
    Fromd(2) = DateSerial(Split(Sm, Chr(2))(0), Split(Sm, Chr(2))(1), 6)
    Tod(2) = DateSerial(Year(Fromd(1)), Month(Fromd(1)) + 1, 5) + 1
End Sub
Private Sub BookSet(ByVal Fary As Variant)
    Const Fnm         As String = "AtBase.xlsm"
    Dim Var           As Variant
    For Each Var In Fary
        FileCopy ThisWorkbook.Path & "\" & Fnm, ThisWorkbook.Path & "\" & Var & ".xlsm"
    Next
End Sub
Private Sub Pstart()
    With Application
        .EnableEvents = False
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
    End With
End Sub
Private Sub Pend()
    With Application
        .EnableEvents = True
        .ScreenUpdating = True
        .Calculation = xlCalculationAutomatic
    End With
End Sub
（隠居じーさん） 2019/09/09(月) 17:26

 おはようございます　＾＾
↑のコードを書いていて思うのですが、他の関数、マクロで計算処理
をしているＢＯＯＫをコピー後、名前を変えたりしていますので、誤
作動のリスクは非常に高いかと。私でしたら動いても　←　ダメかも　(￣▽￣)
業務には使いません。後の計算処理も新規にマクロ化、若しくは関数
を再構築する（フォーマットだけ使う）のならべつですが、アップし
ておいてなんですが、やはり駄作でした。無視してやってください。
。。とほほ～　＾＾；　　　すみませんでした　m(_ _)m
（隠居じーさん） 2019/09/10(火) 07:51

コメント返信：

[ 一覧(最新更新順) ]

[[20190904125443]] 『勤務表 ５日締めと末締めファイルを1回で作成しａx（ひまわり） ページの最後に飛ぶ

[[20190904125443]]　『勤務表　５日締めと末締めファイルを1回で作成しａx（ひまわり）　ページの最後に飛ぶ