こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

解決済みの質問

Excel 通算期間を算出するマクロ

Excelで派遣社員の派遣労働契約を管理しています。
労働契約法により通算雇用期間5年以上で無期雇用へ転換しないといけません。継続的に契約している人はDATEDIF関数で通算雇用期間の算出ができますが、人によっては出入りが激しかったり同じ期間に複数の契約があったりと、関数では間に合わないことがあります。
そこで、図のようなExcelがあった時、連続した雇用期間や空白期間を別シート等に書き出すことはマクロで可能でしょうか。どうか教えて頂きたいです。
※わかりやすいように期間のセルを色付けしています。実際のエクセル表には色はついていません。

投稿日時 - 2018-04-15 15:39:30

QNo.9488856

困ってます

質問者が選んだベストアンサー

ごめんなさい、
間違えています。
(ソースコードのマジックナンバーを無くすときにチョンボっています。)

差し替えます。 m(_ _)m

Sub sample()
 Dim NowTDate As Date
 Dim GetRow As Integer
 Dim PutRow As Integer
 Dim Getsh As Worksheet
 Dim Putsh As Worksheet
 Dim JituCount As Integer
 Dim KaraCount As Integer

 Const GetColf = 6   '契約開始日列
 Const GetColt = 7   '契約終了日列
 
 Const PutColK = 3   '期間名列
 Const PutColF = 4   '期間開始列
 Const PutColT = 5   '期間終了列
 Const PutColD = 6   '期間日数列
 Const PutColM = 7   '期間月数列
 
 Set Getsh = ThisWorkbook.Sheets(1)  '集計元シート
 Set Putsh = ThisWorkbook.Sheets(2)  '主計先シート
 
 JituCount = 1 '契約カウンター
 KaraCount = 1 '空白カウンター
 GetRow = 2   'データの開始行
 PutRow = 2   '出力先のデータ開始行
 
 Putsh.Cells(1, PutColK).Value = ""
 Putsh.Cells(1, PutColF).Value = "開始日"
 Putsh.Cells(1, PutColT).Value = "終了日"
 Putsh.Cells(1, PutColD).Value = "日数"
 Putsh.Cells(1, PutColM).Value = "月数"

 Putsh.Cells(PutRow, PutColF).Value = Getsh.Cells(GetRow, GetColf).Value
 Putsh.Cells(PutRow, PutColT).Value = Getsh.Cells(GetRow, GetColt).Value
 Putsh.Cells(PutRow, PutColK).Value = "期間" & Format(JituCount, "0")
 JituCount = JituCount + 1
 NowTDate = Putsh.Cells(PutRow, PutColT).Value
 
 Do
  GetRow = GetRow + 1
  If Getsh.Cells(GetRow, GetColf).Value = "" Then Exit Sub
 
  If Getsh.Cells(GetRow, GetColf).Value <= NowTDate + 1 Then
   NowTDate = WorksheetFunction.Max(Getsh.Cells(GetRow, GetColt).Value, NowTDate)
   Putsh.Cells(PutRow, PutColT).Value = NowTDate
   Putsh.Cells(PutRow, PutColD).Value = _
    Putsh.Cells(PutRow, PutColT).Value - _
    Putsh.Cells(PutRow, PutColF).Value + 1
  
   Putsh.Cells(PutRow, PutColM).Value = _
    (Year(Putsh.Cells(PutRow, PutColT).Value) * 12 + _
     Month(Putsh.Cells(PutRow, PutColT).Value)) - _
    (Year(Putsh.Cells(PutRow, PutColF).Value) * 12 + _
     Month(Putsh.Cells(PutRow, PutColF).Value)) + 1
  
  Else
   PutRow = PutRow + 1
  
   Putsh.Cells(PutRow, PutColK).Value = "空白" & Format(KaraCount, "0")
   KaraCount = KaraCount + 1
   Putsh.Cells(PutRow, PutColF).Value = NowTDate + 1
   Putsh.Cells(PutRow, PutColT).Value = Getsh.Cells(GetRow, GetColt).Value - 1
  
   PutRow = PutRow + 1
   Putsh.Cells(PutRow, PutColK).Value = "期間" & Format(JituCount, "0")
   JituCount = JituCount + 1
   Putsh.Cells(PutRow, PutColF).Value = Getsh.Cells(GetRow, GetColf).Value
   Putsh.Cells(PutRow, PutColT).Value = Getsh.Cells(GetRow, GetColt).Value
   Putsh.Cells(PutRow - 1, PutColT).Value = Putsh.Cells(PutRow, PutColF).Value - 1
  
   NowTDate = Getsh.Cells(GetRow, GetColt).Value
  
   Putsh.Cells(PutRow, PutColD).Value = _
    Putsh.Cells(PutRow, PutColT).Value - _
    Putsh.Cells(PutRow, PutColF).Value + 1
  
   Putsh.Cells(PutRow - 1, PutColD).Value = _
    Putsh.Cells(PutRow - 1, PutColT).Value - _
    Putsh.Cells(PutRow - 1, PutColF).Value + 1
  
   Putsh.Cells(PutRow, PutColM).Value = _
    (Year(Putsh.Cells(PutRow, PutColT).Value) * 12 + _
     Month(Putsh.Cells(PutRow, PutColT).Value)) - _
    (Year(Putsh.Cells(PutRow, PutColF).Value) * 12 + _
     Month(Putsh.Cells(PutRow, PutColF).Value)) + 1
  
   Putsh.Cells(PutRow - 1, PutColM).Value = _
    (Year(Putsh.Cells(PutRow - 1, PutColT).Value) * 12 + _
     Month(Putsh.Cells(PutRow - 1, PutColT).Value)) - _
    (Year(Putsh.Cells(PutRow - 1, PutColF).Value) * 12 + _
     Month(Putsh.Cells(PutRow - 1, PutColF).Value)) + 1
 
   End If
 Loop

End Sub

投稿日時 - 2018-04-16 10:35:06

お礼

ご丁寧にありがとうございます!
まさに欲しかった結果が得られました。すごい!
大変助かりました、お礼申し上げます。

投稿日時 - 2018-04-19 18:56:38

このQ&Aは役に立ちましたか?

0人が「このQ&Aが役に立った」と投票しています

回答(3)

ANo.3

マクロを使わなくても、各々の期間を算出する列を作り、SUMIFで合計すればいいだけでは?

Excelの日付は、1900年1月1日を1とした連番になっていますから、引き算すれば日数が出てきます(表示形式を標準に戻せばわかります)。日数がわかれば、あとはそれを合計すればいいだけなので。

投稿日時 - 2018-04-16 20:21:37

お礼

ありがとうございます。
同一の期間に掛け持ちして働いている場合もあり、関数だけでは対応できないことがありました。

投稿日時 - 2018-04-19 18:59:33

ANo.1

こんなカンジでいかがでしょうか。
ほとんどテストしていませんので、ポカがあるかもしれません。
よかったら参考にしてください。

※思ったよりボリュームがありました。(^^)/~~~

Sub sample()
 Dim NowTDate As Date
 Dim GetRow As Integer
 Dim PutRow As Integer
 Dim Getsh As Worksheet
 Dim Putsh As Worksheet
 Dim JituCount As Integer
 Dim KaraCount As Integer
 
 Const GetColf = 6   '契約開始日列
 Const GetColt = 7   '契約終了日列
 
 Const PutColK = 3   '期間名列
 Const PutColF = 4   '期間開始列
 Const PutColT = 5   '期間終了列
 Const PutColM = 6   '期間月数列
 Const PutColD = 7   '期間日数列
 
 Set Getsh = ThisWorkbook.Sheets(1)  '集計元シート
 Set Putsh = ThisWorkbook.Sheets(2)  '主計先シート
  
 JituCount = 1 '契約カウンター
 KaraCount = 1 '空白カウンター
 GetRow = 2   'データの開始行
 PutRow = 2   '出力先のデータ開始行
  
 Putsh.Cells(1, PutColK).Value = ""
 Putsh.Cells(1, PutColF).Value = "開始日"
 Putsh.Cells(1, PutColT).Value = "終了日"
 Putsh.Cells(1, PutColM).Value = "日数"
 Putsh.Cells(1, PutColD).Value = "月数"
 
 Putsh.Cells(PutRow, PutColF).Value = Getsh.Cells(GetRow, GetColf).Value
 Putsh.Cells(PutRow, PutColT).Value = Getsh.Cells(GetRow, GetColt).Value
 Putsh.Cells(PutRow, PutColK).Value = "期間" & Format(JituCount, "0")
 JituCount = JituCount + 1
 NowTDate = Putsh.Cells(PutRow, PutColT).Value
  
 Do
  GetRow = GetRow + 1
  If Getsh.Cells(GetRow, GetColf).Value = "" Then Exit Sub
   
  If Getsh.Cells(GetRow, GetColf).Value <= NowTDate + 1 Then
   NowTDate = WorksheetFunction.Max(Getsh.Cells(GetRow, GetColt).Value, NowTDate)
   Putsh.Cells(PutRow, PutColT).Value = NowTDate
    Putsh.Cells(PutRow, PutColM).Value = _
    Putsh.Cells(PutRow, PutColT).Value - _
    Putsh.Cells(PutRow, PutColF).Value + 1
     
   Putsh.Cells(PutRow, PutColD).Value = _
    (Year(Putsh.Cells(PutRow, PutColT).Value) * PutColM + _
     Month(Putsh.Cells(PutRow, PutColT).Value)) - _
    (Year(Putsh.Cells(PutRow, PutColF).Value) * PutColM + _
     Month(Putsh.Cells(PutRow, PutColF).Value)) + 1
     
  Else
   PutRow = PutRow + 1
   
   Putsh.Cells(PutRow, PutColK).Value = "空白" & Format(KaraCount, "0")
   KaraCount = KaraCount + 1
   Putsh.Cells(PutRow, PutColF).Value = NowTDate + 1
   Putsh.Cells(PutRow, PutColT).Value = Getsh.Cells(GetRow, GetColt).Value - 1
    
   PutRow = PutRow + 1
   Putsh.Cells(PutRow, PutColK).Value = "期間" & Format(JituCount, "0")
   JituCount = JituCount + 1
   Putsh.Cells(PutRow, PutColF).Value = Getsh.Cells(GetRow, GetColf).Value
   Putsh.Cells(PutRow, PutColT).Value = Getsh.Cells(GetRow, GetColt).Value
   Putsh.Cells(PutRow - 1, PutColT).Value = Putsh.Cells(PutRow, PutColF).Value - 1
    
   NowTDate = Getsh.Cells(GetRow, GetColt).Value
    
   Putsh.Cells(PutRow, PutColM).Value = _
    Putsh.Cells(PutRow, PutColT).Value - _
    Putsh.Cells(PutRow, PutColF).Value + 1
    
   Putsh.Cells(PutRow - 1, PutColM).Value = _
    Putsh.Cells(PutRow - 1, PutColT).Value - _
    Putsh.Cells(PutRow - 1, PutColF).Value + 1
    
   Putsh.Cells(PutRow, PutColD).Value = _
    (Year(Putsh.Cells(PutRow, PutColT).Value) * PutColM + _
     Month(Putsh.Cells(PutRow, PutColT).Value)) - _
    (Year(Putsh.Cells(PutRow, PutColF).Value) * PutColM + _
     Month(Putsh.Cells(PutRow, PutColF).Value)) + 1
    
   Putsh.Cells(PutRow - 1, PutColD).Value = _
    (Year(Putsh.Cells(PutRow - 1, PutColT).Value) * PutColM + _
     Month(Putsh.Cells(PutRow - 1, PutColT).Value)) - _
    (Year(Putsh.Cells(PutRow - 1, PutColF).Value) * PutColM + _
     Month(Putsh.Cells(PutRow - 1, PutColF).Value)) + 1
   
  End If
 Loop

End Sub

投稿日時 - 2018-04-15 21:15:47

あなたにオススメの質問