表に入力されたデータに従って
開始日から終了日までの平日の連続データを作って
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
注意点
使っているシステムに合わせて要編集