hiko-blog

VBA業務改善

MENU

毎月の土曜日と日曜日 抽出

Sub ExtractWeekendDates()
    Dim startDate As Date
    Dim endDate As Date
    Dim currentDate As Date
    Dim ws As Worksheet
    Dim rowNum As Long
    
    ' 新しいシートを作成します
    Set ws = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
    ws.Name = "WeekendDates" ' シートの名前を設定します
    
    ' ヘッダーを設定します
    ws.Range("A1").Value = "Date"
    ws.Range("B1").Value = "Day"
    
    ' 開始日と終了日を設定します
    startDate = DateSerial(Year(Date), Month(Date), 1) ' 現在の月の1日を取得
    endDate = DateSerial(Year(Date), Month(Date) + 1, 0) ' 現在の月の最終日を取得
    
    ' データを転記します
    rowNum = 2 ' データを書き込む最初の行を設定します
    For currentDate = startDate To endDate
        ' もし土曜日または日曜日であれば、その日付と曜日を書き込みます
        If Weekday(currentDate) = vbSaturday Or Weekday(currentDate) = vbSunday Then
            ws.Cells(rowNum, 1).Value = Format(currentDate, "yyyy/mm/dd") ' 日付を書き込みます
            ws.Cells(rowNum, 2).Value = WeekdayName(Weekday(currentDate)) ' 曜日を書き込みます
            rowNum = rowNum + 1 ' 次の行に移動します
        End If
    Next currentDate
End Sub