『シフト表を作成しています。コード修正をしてほしいです。』（けんちゃん）
シフト表のフォーマットとしては、以下の感じです。
C4：AF4には、１～３１日（月によって変動あり）
B７：B:20はスタッフ氏名
C7:AG20にシフトが入力されます。
AK７：AO２０には、希望する休みの日を入力します。
例えば、７行目のスタッフが１と入力すれば C7に"/"が表示されます。
そして、先ほど入力した１をけしたら、表示されていたC7の"/"が削除されます。
このようにコードを書いていますが、"/"の削除ができません。
作成したコードを提示しますので、間違い箇所の修正をお願いできますでしょうか？
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo ExitProc
Application.EnableEvents = False
Dim rng As Range
Dim cell As Range
Dim r As Long, c As Long
Dim cellValue As String
Dim totalTime As Double
Dim hasB As Boolean, hasE As Boolean
Dim delta As Double
'====================
' 勤務時間の合計処理
'====================
Set rng = Intersect(Target, Me.Range("C7:AG20"))
If Not rng Is Nothing Then
For Each cell In rng.Rows
r = cell.Row
totalTime = 0
hasB = False
hasE = False
For c = 3 To 33
cellValue = Me.Cells(r, c).Value
If cellValue = "B" Then hasB = True
If cellValue = "E" Then hasE = True
Next c
For c = 3 To 33
cellValue = Trim(Me.Cells(r, c).Value)
If cellValue = "B" Then
totalTime = totalTime + 8
ElseIf cellValue = "E" Then
totalTime = totalTime + 8.5
ElseIf (cellValue Like "B+*" Or cellValue Like "B-*") Then
delta = Val(Mid(cellValue, 3))
If Left(cellValue, 2) = "B+" Then
totalTime = totalTime + (8 + delta)
ElseIf Left(cellValue, 2) = "B-" Then
totalTime = totalTime + (8 - delta)
End If
ElseIf (cellValue Like "E+*" Or cellValue Like "E-*") Then
delta = Val(Mid(cellValue, 3))
If Left(cellValue, 2) = "E+" Then
totalTime = totalTime + (8.5 + delta)
ElseIf Left(cellValue, 2) = "E-" Then
totalTime = totalTime + (8.5 - delta)
End If
ElseIf cellValue = "研" Or cellValue = "有" Or cellValue = "特" Then
If hasE Then
totalTime = totalTime + 8.5
ElseIf hasB Then
totalTime = totalTime + 8
End If
End If
Next c
Me.Cells(r, 34).Value = totalTime ' AH列に出力
Next cell
End If
'====================
' 休み記号（/）処理
'====================
Set rng = Intersect(Target, Me.Range("AK7:AO20"))
If Not rng Is Nothing Then
Dim colHeaderRange As Range
Dim headerCell As Range
Dim dayValue As Variant
Set colHeaderRange = Me.Range("C4:AG4")
For Each cell In rng
r = cell.Row
dayValue = cell.Value
' 数値が入力された場合 → 対応セルに「/」を入力
If IsNumeric(dayValue) Then
For Each headerCell In colHeaderRange
If headerCell.Value <> "" And IsNumeric(headerCell.Value) Then
If CLng(headerCell.Value) = CLng(dayValue) Then
Me.Cells(r, headerCell.Column).Value = "/"
Exit For
End If
End If
Next headerCell
' 数値が削除された場合 → 対応する「/」を削除
ElseIf IsEmpty(dayValue) Or dayValue = "" Then
' Target の変更前のセル内容を取得できないため、対応する列を調べて「/」を消す
Dim targetCol As Long
For targetCol = 3 To 33 ' C列～AG列
Set headerCell = Me.Cells(4, targetCol)
If headerCell.Value <> "" And IsNumeric(headerCell.Value) Then
' その日付が AK～AO にまだ残っているか？
Dim stillExists As Boolean: stillExists = False
Dim tmpCell As Range
For Each tmpCell In Me.Range("AK" & r & ":AO" & r)
If IsNumeric(tmpCell.Value) And CLng(tmpCell.Value) = CLng(headerCell.Value) Then
stillExists = True
Exit For
End If
Next tmpCell
' 存在しなければ該当セルの / を消す
If Not stillExists Then
If Me.Cells(r, headerCell.Column).Value = "/" Then
Me.Cells(r,headerCell.Column).ClearContents
End If
End If
End If
Next targetCol
End If
Next cell
End If
ExitProc:
Application.EnableEvents = True
End Sub
＜ 使用 アプリ：2024、使用 OS：Windows11 ＞
とりあえずこれで。
' 数値が入力された場合 → 対応セルに「/」を入力
If IsNumeric(dayValue) And Not dayValue = "" Then
~~~~~~~~~~~~~~~~~~~~~
（知らんけど） 2025/05/27(火) 20:46:58
>' Target の変更前のセル内容を取得できないため Application.Undo を実行すれば、消す前の値が出現します。 それをcell.Valueで取得して、再度そのセルをEmptyにしておけば済みます。
（xyz） 2025/05/27(火) 21:18:34
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.