勤怠システム（勤給解決）の時間単位休暇取り込み用csvを自動作成するマクロ

表に入力されたデータに従って

開始日から終了日までの平日の連続データを作って

csvを自動作成するマクロ

下準備

マクロを入れるエクセルに「マクロ」という名前のシートを作成し、以下のような形式で元データとなる表を入力する。

「csv」シートを作成し先頭行を入力しておく。

「祝日リスト」シートを作成し、連続データから除外したい日のリストを作っておく。

コード

Sub 部分休業csv()
    Dim sourcews As Worksheet
    Dim lastrow As Long
    Dim i As Long
    Dim number As Long
    Dim nameStr As String
    Dim holiday As String
    Dim startDate As Date
    Dim endDate As Date
    Dim currentDate As Date
    Dim pattern As Long
    Dim starttime As String
    Dim endtime As String
    Dim csvws As Worksheet
    Dim r As Long
    Dim currentCell As Range
    Dim sheetname As String
    Dim holidaysdata As Variant
    Dim holidayList As Worksheet
    Dim RowNum As Integer
    
    'リストのワークシートを設定
    Set sourcews = Sheets("マクロ")
    
    ' 最終行を取得
    lastrow = sourcews.Range("A1").CurrentRegion.Rows.Count
    
    ' csvシートを指定
    Set csvws = Sheets("csv")
    '過去のデータを消去
    csvws.Range("A:H").CurrentRegion.Offset(1, 0).ClearContents
    
    ' 繰り返し
    For i = 2 To lastrow
        
        ' 入力データを指定
        With sourcews
            number = .Cells(i, 1)
            nameStr = .Cells(i, 2)
            holiday = .Cells(i, 3)
            startDate = .Cells(i, 4)
            endDate = .Cells(i, 5)
            pattern = .Cells(i, 6)
            starttime = .Cells(i, 7)
            endtime = .Cells(i, 8)
        End With
    
        'csvシートの入力行を取得
        r = csvws.Range("A1").CurrentRegion.Rows.Count + 1
        
        ' 祝日データを祝日リストシートから読み込む
        Set holidayList = ThisWorkbook.Sheets("祝日リスト")
        holidaysdata = holidayList.Range("A1").CurrentRegion.Value
    
        ' A列の最初の行から開始
        RowNum = 1
    
        ' 開始日から終了日までループ
         For currentDate = startDate To endDate
            Set currentCell = csvws.Cells(r, 1)
                ' 平日でかつ祝日でない場合のみ日付を入力
                If Weekday(currentDate, vbMonday) <= 5 And Not IsInArray(currentDate, holidaysdata) Then
                    currentCell = currentDate
                    currentCell.Offset(0, 1) = Format(number, "0000000000")
                    currentCell.Offset(0, 2) = Format(pattern, "00000")
                    currentCell.Offset(0, 5) = holiday
                    currentCell.Offset(0, 6) = starttime
                    currentCell.Offset(0, 7) = endtime
                    Set currentCell = currentCell.Offset(1, 0)
                    startDate = startDate + 1
                    r = r + 1
                    RowNum = RowNum + 1
                End If
                
        Next currentDate
        
        sheetname = sheetname & "_" & nameStr
    
    Next i
   ' シートをcsv形式で保存
    Dim csvFileName As String
    csvFileName = ThisWorkbook.Path & "\" & Format(Date, "yyyymmdd") & sheetname & ".csv"
    csvws.Copy
    ActiveWorkbook.SaveAs Filename:=csvFileName, FileFormat:=xlCSV
    ActiveWorkbook.Close False
    
    MsgBox "csv出力完了"
 
End Sub
 
Function IsInArray(ByVal val As Variant, arr As Variant) As Boolean
    Dim element As Variant
    On Error Resume Next
    For Each element In arr
        If element = val Then
            IsInArray = True
            Exit Function
        End If
    Next element
    IsInArray = False
End Function

注意点

使っているシステムに合わせて要編集