■
以下は、VBAを使用してこのタスクを実行するためのサンプルコードです。
```vb
Sub FillData()
Dim rng As Range
Dim cell As Range
Dim count As Integer
Dim lastRow As Integer
' データの範囲を指定します
Set rng = Range("C3:AG3")
' データが満たされているか確認します
count = WorksheetFunction.CountA(rng)
' データが連続して4つ以下の場合に処理を実行します
If count <= 4 Then
' 最終行の番号を取得します
lastRow = rng.Rows.Count + rng.Row - 1
' データが入っていないセルに○を追加します
For Each cell In rng
If cell.Value = "" Then
cell.Value = "○"
End If
Next cell
' データが満たされた後ろのセルには○を削除します
For Each cell In Range(Cells(rng.Row, count + 3), Cells(rng.Row, lastRow))
If cell.Value = "○" Then
cell.ClearContents
End If
Next cell
End If
End Sub
```
上記のコードをVBAエディタに貼り付け、実行すると、指定された範囲（C3〜AG3）にデータがランダムに追加されます。ただし、データが連続して4つ以上の場合、またはデータがすでに満たされている場合には、セルに追加の「○」は入りません。
■
以下は、VBAで指定された範囲（C3:AG11）に制約を満たす18個のランダムな"○"を配置するコードです。
```vba
Sub InsertRandomO()
Dim rng As Range
Dim cell As Range
Dim count As Integer
Dim i As Integer
Set rng = Range("C3:AG11")
' ループで範囲を拡大
For i = 1 To (rng.Rows.Count * rng.Columns.Count) \/ 9
' 各範囲に3つの"○"をランダムに配置
For Each cell In rng
' "○"が5つ以上続いた場合、次のセルに移動
If count >= 5 Then
count = 0
Set cell = cell.Offset(0, 1)
End If
' ランダムに"○"を配置
If WorksheetFunction.RandBetween(1, 2) = 1 Then
cell.Value = "○"
count = count + 1
Else
cell.Value = ""
count = 0
End If
Next cell
' 制約を満たすようにシャッフル
Call ShuffleRange(rng)
Next i
End Sub
Sub ShuffleRange(rng As Range)
Dim cell As Range
Dim tempArray() As Variant
Dim i As Long
Dim j As Long
' 範囲の値を一時的に配列に格納
tempArray = rng.Value
' 一次元配列に変換
tempArray = Application.WorksheetFunction.Transpose(Application.WorksheetFunction.Transpose(tempArray))
' 配列をシャッフル
For i = LBound(tempArray) To UBound(tempArray)
j = Int(Rnd() * (UBound(tempArray) - i + 1)) + i
If i <> j Then
tempArray(i) = tempArray(i) Xor tempArray(j)
tempArray(j) = tempArray(i) Xor tempArray(j)
tempArray(i) = tempArray(i) Xor tempArray(j)
End If
Next i
' シャッフルした値を範囲に戻す
rng.Value = Application.WorksheetFunction.Transpose(Application.WorksheetFunction.Transpose(tempArray))
End Sub
```
上記のコードをVBAエディタに貼り付け、`InsertRandomO`プロシージャを実行（F5キーを押すなど）すると、指定された範囲（C3:AG11）に制約を満たすランダムな"○"が配置されます。"○"が5つ以上連続する場合、次のセルに自動的に移動して配置します。また、C3:C11までの範囲には3つの"○"が配置され、AG3:AG11までループするようになっています。
なお、ランダムな配置を作成するために、`ShuffleRange`プロシージャが追加されました。これにより、配列をシャッフルすることでランダムな値の配置を作成します。
■
以下は、修正後のプログラムです。このプログラムでは、カレンダーの日付をB2から行で、スタッフをA2から列で表示し、出勤のスタッフは日付の行に"○"を入れるように設定します。
```vba
Sub CreateShift()
Dim staff As Variant
Dim attendance As Variant
Dim numOfStaff As Integer
Dim shiftCount As Integer
Dim daysPerMonth As Integer
Dim startDate As Date
Dim endDate As Date
Dim currentRow As Integer
Dim currentColumn As Integer
Dim i As Integer
Dim j As Integer
'スタッフの名前
staff = Array("スタッフ1", "スタッフ2", "スタッフ3", "スタッフ4", "スタッフ5", "スタッフ6")
'土日祝の出勤回数
attendance = Array(0, 0, 0, 0, 0, 0)
numOfStaff = UBound(staff) + 1
daysPerMonth = 31 '対象の月の日数を設定
shiftCount = daysPerMonth \\\/ 2 '1日2人出勤なのでシフト数は出勤日数の半分
startDate = DateSerial(2023, 12, 1) '対象の月の開始日を設定
endDate = DateSerial(2023, 12, daysPerMonth) '対象の月の終了日を設定
currentRow = 2 'カレンダーの日付行の開始行
currentColumn = 2 'スタッフ行の開始列
'カレンダーの日付を設定
For i = 0 To daysPerMonth - 1
Cells(currentRow, currentColumn + i).Value = startDate + i
Next i
'スタッフを設定し、出勤日に"○"を入れる
For i = 0 To daysPerMonth - 1
For j = 0 To shiftCount - 1
Dim randomIndex As Integer
Dim selectedStaff As String
Do
randomIndex = Int((numOfStaff - 1 + 1) * Rnd + 1)
selectedStaff = staff(randomIndex - 1)
Loop Until attendance(randomIndex - 1) < shiftCount
attendance(randomIndex - 1) = attendance(randomIndex - 1) + 1
Cells(currentRow + j, currentColumn + i).Value = selectedStaff
Next j
Next i
End Sub
```
このプログラムを実行すると、対象の月のカレンダーを作成し、スタッフをランダムにシフトに配置します。出勤するスタッフは該当の日に"○"を入れます。
なお、この例では2023年12月の日数を31日に設定していますが、必要に応じて変更する必要があります。また、カレンダーの開始日は`startDate`で指定し、その月の日数は`daysPerMonth`で指定しています。同様に、スタッフ行の開始列は`currentColumn`で指定していますので、必要に応じて変更してください。
■
以下は、修正後のプログラムです。このプログラムでは、`shiftCount`を変更してシフト数を調整することで、1ヶ月の出勤日数を18日になるように設定します。
```vba
Sub CreateShift()
Dim staff As Variant
Dim attendance As Variant
Dim numOfStaff As Integer
Dim shiftCount As Integer
Dim daysPerMonth As Integer
Dim i As Integer
Dim j As Integer
'スタッフの名前
staff = Array("スタッフ1", "スタッフ2", "スタッフ3", "スタッフ4", "スタッフ5", "スタッフ6")
'土日祝の出勤回数
attendance = Array(0, 0, 0, 0, 0, 0)
numOfStaff = UBound(staff) + 1
daysPerMonth = 18
shiftCount = daysPerMonth \/ 2 '1日2人出勤なのでシフト数は出勤日数の半分
'2人のスタッフをランダムに選出し、シフトに設定
For i = 1 To shiftCount
For j = 1 To 2
Dim randomIndex As Integer
Dim selectedStaff As String
Do
randomIndex = Int((numOfStaff - 1 + 1) * Rnd + 1)
selectedStaff = staff(randomIndex - 1)
Loop Until attendance(randomIndex - 1) < shiftCount
attendance(randomIndex - 1) = attendance(randomIndex - 1) + 1
Cells(i, j).Value = selectedStaff
Next j
Next i
'土日祝の出勤回数が全員同じ数になるように調整
Do
Dim minAttendance As Integer
Dim minIndex As Integer
Dim maxAttendance As Integer
Dim maxIndex As Integer
'最も出勤回数の少ないスタッフと最も出勤回数の多いスタッフを探す
minAttendance = Application.Min(attendance)
minIndex = Application.Match(minAttendance, attendance, 0)
maxAttendance = Application.Max(attendance)
maxIndex = Application.Match(maxAttendance, attendance, 0)
'出勤回数の多いスタッフのシフトを変更して出勤回数を調整
For i = 1 To shiftCount
If Cells(i, 1).Value = staff(maxIndex - 1) Or Cells(i, 2).Value = staff(maxIndex - 1) Then
attendance(minIndex - 1) = attendance(minIndex - 1) + 1
attendance(maxIndex - 1) = attendance(maxIndex - 1) - 1
Cells(i, 1).Value = staff(minIndex - 1)
Exit For
End If
Next i
Loop Until Application.Min(attendance) = shiftCount
'結果を出力
For i = 1 To shiftCount
For j = 1 To 2
Debug.Print Cells(i, j).Value
Next j
Next i
End Sub
```
このプログラムを実行すると、VBAエディタ内で結果がデバッグウィンドウに表示されます。必要に応じてデバッグウィンドウの代わりに結果をExcelシートに出力する場合は、`Debug.Print Cells(i, j).Value` を `Cells(i, j).Value = Cells(i, j).Value` に変更してください。
この例では、1ヶ月の出勤日数を18日に設定し、その日数に基づいてシフトを作成します。ただし、スタッフ数が6人、出勤日数が18日、1日2人出勤するためシフト数が9回と固定されており、必要に応じて変更する必要があります。
■
はじめに、VBAを使用して次の手順に従ってシフトを作成する基本的なコードを示します。
```vba
Sub CreateShift()
' 定数宣言
Const NUMBER_OF_STAFF As Integer = 6 ' スタッフの人数
Const WORK_DAYS As Integer = 18 ' 月の出勤日数
Const MAX_CONSECUTIVE_DAYS As Integer = 5 ' 最大連勤日数
' 変数宣言
Dim shiftTable(1 To WORK_DAYS) As Integer ' シフト表
Dim staffCount(1 To NUMBER_OF_STAFF) As Integer ' 各スタッフの出勤数
' シフト表を初期化
For i = 1 To WORK_DAYS
shiftTable(i) = 0
Next i
' スタッフの出勤数を初期化
For i = 1 To NUMBER_OF_STAFF
staffCount(i) = 0
Next i
' 土日祝の出勤を全員同じ数にする
For i = 1 To WORK_DAYS
If Weekday(CDate("2022\/01\/" & i)) = vbSaturday Or Weekday(CDate("2022\/01\/" & i)) = vbSunday Then
' 土曜日または日曜日は全員出勤
For j = 1 To NUMBER_OF_STAFF
shiftTable(i) = j
staffCount(j) = staffCount(j) + 1
Next j
ElseIf IsHoliday(CDate("2022\/01\/" & i)) Then
' 祝日は全員出勤
For j = 1 To NUMBER_OF_STAFF
shiftTable(i) = j
staffCount(j) = staffCount(j) + 1
Next j
End If
Next i
' 最大連勤日数を超えないようにスタッフを配置
For i = 1 To WORK_DAYS
If shiftTable(i) = 0 Then
' 当日が未決定の場合
For j = 1 To NUMBER_OF_STAFF
If staffCount(j) < MAX_CONSECUTIVE_DAYS Then
' スタッフの最大連勤日数に達していない場合
shiftTable(i) = j
staffCount(j) = staffCount(j) + 1
Exit For
End If
Next j
End If
Next i
' シフト表を出力
For i = 1 To WORK_DAYS
Debug.Print "2022\/01\/" & i & ": スタッフ" & shiftTable(i)
Next i
End Sub
Function IsHoliday(dateValue As Date) As Boolean
' 祝日の判定ロジックを実装（ここでは省略）
' 祝日の場合はTrueを、祝日でない場合はFalseを返す
'
' 例：
' If dateValue = CDate("2022\/01\/01") Then
' IsHoliday = True ' 元日は祝日なのでTrueを返す
' Else
' IsHoliday = False ' その他の日は祝日でないのでFalseを返す
' End If
End Function
```
上記のコードをVBAのモジュールに貼り付け、シフトを作成するために`CreateShift`サブルーチンを実行してください。シフト表がDebugウィンドウに出力されます。
コードの中で、「祝日の判定ロジックを実装」というコメントがありますが、この部分は実際の祝日の判定ロジックを実装する必要があります。もし利用可能な祝日のリストや算出方法があれば、それに基づいて判定ロジックを作成してください。
また、上記のコードでは6人のスタッフと月の出勤日数を18日、最大連勤日数を5日に設定していますが、必要に応じてこれらの値を変更してください。
以上が、VBAを使用してシフトを作成するための基本的なコードです。このコードをベースに、さらに機能を追加するなどして、応用的なシフト作成プログラムを実装することができます。
■
vba シート１のA～Hセルの内容がシート２のBC、J～Oセル内になければシート３のA～Hセルに出力
Sub データの比較と出力()
Dim シート1 As Worksheet
Dim シート2 As Worksheet
Dim シート3 As Worksheet
Dim 最終行1 As Long
Dim i As Long
Dim 見つかった As Boolean
' シート1とシート2、シート3の参照を取得
Set シート1 = ThisWorkbook.Sheets("シート1") ' "シート1"はシート1の実際の名前に変更してください
Set シート2 = ThisWorkbook.Sheets("シート2") ' "シート2"はシート2の実際の名前に変更してください
Set シート3 = ThisWorkbook.Sheets("シート3") ' "シート3"はシート3の実際の名前に変更してください
' シート1の最終行を取得
最終行1 = シート1.Cells(シート1.Rows.Count, "A").End(xlUp).Row
' シート1のデータをシート2およびシート3と比較して出力
For i = 1 To 最終行1
見つかった = False
' シート2のBC列およびJ列からO列を検索
If データが存在する(シート1.Cells(i, "A").Value, シート2.Range("B:C,J:O")) Then
見つかった = True
End If
' シート3に出力
If Not 見つかった Then
シート3.Cells(シート3.Cells(シート3.Rows.Count, "A").End(xlUp).Row + 1, "A").Resize(, 8).Value = _
シート1.Cells(i, "A").Resize(, 8).Value
End If
Next i
End Sub
Function データが存在する(検索対象 As Variant, 検索範囲 As Range) As Boolean
Dim セル As Range
For Each セル In 検索範囲
If セル.Value = 検索対象 Then
データが存在する = True
Exit Function
End If
Next セル
データが存在する = False
End Function
このコードでは、データが存在する関数を使って、シート2のBC列およびJ列からO列にデータが存在するかどうかを確認しています。もし存在しない場合は、シート3にそのデータを出力します。なお、実際のシート名が異なる場合は、コード内のシート名を適切に変更してください。
■
VBAを使用して読み取り専用のフォルダを開くには、`Shell`関数を使用します。
以下は、フォルダパスを指定して読み取り専用のフォルダを開く例です。
```vba
Sub OpenReadOnlyFolder()
Dim FolderPath As String
' フォルダパスを指定します
FolderPath = "C:\\Path\\To\\Your\\Folder"
' フォルダを読み取り専用モードで開きます
Shell "explorer \/root," & FolderPath, vbNormalFocus
End Sub
```
上記のコードでは、`FolderPath`変数に開きたいフォルダのパスを指定しています。`Shell`関数を使用して、`explorer \/root,`の後にフォルダパスを指定しています。
このコードを実行すると、指定したフォルダが読み取り専用モードで開かれます。
なお、この方法ではフォルダを開くだけであり、フォルダ内のファイルは読み取り専用というわけではありません。フォルダ内のファイルを個別に読み取り専用にするには、各ファイルを開き、読み取り専用モードで保存する必要があります。
