（変数の扱いが不適切でしたので修正しました。元発言は23/01/04 22:18:03 でした）
「シフト表への勤務パターン入力について」
https://www.moug.net/faq/viewtopic.php?t=81966
トライがなかったのは残念です。
後続の質問がいつになるか不明ですので、準備しておいたものをメモします。
【シートレイアウト】
F列G H I J K L M N O P Q R S T U V W X Y Z ....
6 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21
7 水 木 金 土 日 月 火 水 木 金 土 日 月 火 水 木 金 土 日 月 火
8 B B C B
9 C B B C
10 C B B C
11 C B B C
12 C B C
13 B C B C
14 B C B C
15 B C B
16 B C B
【使用方法】
・最初の営業日（一日でなくても構いません）にだけ、
"B"と"C"をシートに直接記入してください。
・以下のコードを標準モジュールにコピーペイストし、
・mainマクロを実行してください。(現在のアクティブシートを処理します）
=== 参考コード ======================
Option Explicit
Sub main()
Dim rB As Long ' "B"を書き込むセルの行番号
Dim rC As Long ' "C"を書き込むセル 〃
Dim s As String
Dim v As Variant
Dim colm As Long
Dim k As Long
'最初の営業日の"B","C"の位置を探す
v = getData("B") ''最初の営業日の情報を読み取る
rB = v(0) '' rB: "B"が書き込まれているセルの行番号
colm = v(1) '' colm: 最初の営業日がある列番号
v = getData("C")
rC = v(0) '' rB: "C"が書き込まれているセルの行番号
If rB = 0 Or rC = 0 Then Exit Sub
''' 初期化
''' Cells(8, colm + 1).Resize(9, 31).ClearContents
'各日にB,Cを書き込む
For k = colm + 1 To Cells(6, Columns.Count).End(xlToLeft).Column
s = Cells(7, k) '曜日
Select Case s
Case "日", "祝"
'何もせず
Case "土"
' "B"のみ処理
rB = rB + 1
If rB = 17 Then rB = 8
Cells(rB, k) = "B"
Case Else
' "C"を先に処理
rC = rC + 1
If rC = 17 Then rC = 8
Cells(rC, k) = "C"
' 次に"B"を処理
rB = rB + 1
If rB = 17 Then rB = 8
If rB = rC Then
rB = rB + 1
If rB = 17 Then rB = 8
End If
Cells(rB, k) = "B"
End Select
Next
End Sub
Rem 最初の営業日の情報を読み取る
Function getData(str As String) As Variant
Dim myRange As Range
Dim r As Range
Set myRange = Cells(8, 6).Resize(9, 10) '最初の営業日は10日までと仮定
'左の列から順次B,Cを検索します
Set r = myRange.Find(What:=str, After:=myRange.Cells(90), LookIn:=xlFormulas, _
LookAt:=xlWhole, SearchOrder:=xlByColumns, _
SearchDirection:=xlNext, MatchCase:=False, MatchByte:=False, _
SearchFormat:=False)
If r Is Nothing Then
MsgBox str & "を設定してください"
getData = Array(0, 0)
Exit Function
Else
getData = Array(r.Row, r.Column)
End If
End Function
