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

質問

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

回答No.2

HohoPapa · ベストアンサー

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

差し替えます。　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

お礼

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

回答No.3

FEX2053

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

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

お礼

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

回答No.1

HohoPapa

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

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

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