Excel VBA 質問スレッド №2073 (未解決)

基準を判定するマクロ(追加質問てらてら様)

投稿者 : ブラック職場     投稿日時 : 2025/01/25(Sat) 01:23:20     OS : 未指定     EXCEL : 未指定
以前にご助力いただいたコードを勉強しながら、アレンジさせてもらっているなかで
どうしてもわからない箇所がありますので質問させてください。

●以前の質問内容 Excel VBA 質問スレッド №2068
仮定で部活を開催する基準があります。(下記、基準画像)
そして職員の出勤表があります。(下記、出勤表画像)
職員の出勤表が、基準を満たしているか判定するマクロを、ご指導賜りますようお願い申し上げます。
基準画像:https://ibb.co/WWy4V5Q
出勤表画像:https://ibb.co/QnYFQVd

●ご教授いただいたコード
Sub macro()
    Dim i As Long, cnt As Long, total As Long
    Dim b As Boolean
    b = False
    
    'データセット
    Range("I6:J11").ClearContents
    
    If Range("F4") = "〇" Then Range("I6") = 1
    If Range("F5") = "〇" Then Range("I7") = 1
    cnt = 0
    For i = 6 To 9
        If Cells(i, "F") = "〇" Then
            cnt = cnt + 1
            If Not InStr(Cells(i, "E"), "非常勤") > 0 Then Range("J8") = "常勤"
        End If
    Next i
    Range("I8") = cnt
    
    cnt = 0
    For i = 10 To 13
        If Cells(i, "F") = "〇" Then
            cnt = cnt + 1
            If Not InStr(Cells(i, "E"), "非常勤") > 0 Then Range("J9") = "常勤"
        End If
    Next i
    Range("I9") = cnt
    
    cnt = 0
    For i = 14 To 15
        If Cells(i, "F") = "〇" Then
            cnt = cnt + 1
            If InStr(Cells(i, "E"), "専従") > 0 Then Range("J10") = "専従"
        End If
    Next i
    Range("I10") = cnt
    
    cnt = 0
    For i = 16 To 17
        If Cells(i, "F") = "〇" Then
            cnt = cnt + 1
            If InStr(Cells(i, "E"), "専従") > 0 Then Range("J11") = "専従"
        End If
    Next i
    Range("I11") = cnt
    
    
    '// 判定条件
    '校長、教頭のどちらかがいなければNG
    If Range("I6") = 0 And Range("I7") = 0 Then GoTo LABEL
         
    '①
    cnt = Range("I8") + Range("I9")
        'コーチ、看護師が専従なら含める
    If InStr(Range("J10"), "専従") > 0 Then cnt = cnt + 1
    If InStr(Range("J11"), "専従") > 0 Then cnt = cnt + 1
    If cnt < 2 Then GoTo LABEL
    
    
    '②
    total = Application.WorksheetFunction.Sum(Range("I6:I11"))
        'コーチ、看護師が専従なら含める
    If InStr(Range("J10"), "専従") > 0 Then total = total + 1
    If InStr(Range("J11"), "専従") > 0 Then total = total + 1
        
    If total / 2 < cnt Then GoTo LABEL
    
    '③
    If InStr(Range("J8"), "常勤") = 0 And InStr(Range("J9"), "常勤") = 0 Then GoTo LABEL
    
    '定員
    Dim 必要人員 As Long
    必要人員 = ((Range("I3") - 1) ¥ 5) + 1
    If total < 必要人員 Then GoTo LABEL
    
    b = True
    
LABEL:
    If b = False Then
        Range("I14") = "NG"
    Else
        Range("I14") = "OK"
    End If
End Sub



●追加質問内容

total = Application.WorksheetFunction.Sum(Range("I6:I11"))
'コーチ、看護師が専従なら含める
If InStr(Range("J10"), "専従") > 0 Then total = total + 1
If InStr(Range("J11"), "専従") > 0 Then total = total + 1

If total / 2 < cnt Then GoTo LABEL

このコードの、

If total / 2 < cnt Then GoTo LABEL

はどんな意図があるのでしょうか?
なぜtotalの値を2で割るのか?
そしてcntと比較されるのか?
お気を悪くさせてしまったなら申し訳ありませんが、どうしても自身では解決できなく。
申し訳ありませんが、ご教授ください。

スポンサーリンク
[返信 1] Re : 基準を判定するマクロ(追加質問てらてら様)
投稿者 : てらてら     投稿日時 : 2025/01/25(Sat) 06:11:05
こんにちは。
別に気を悪くするような事はありませんよ。

>If total / 2 < cnt Then GoTo LABEL
>
>はどんな意図があるのでしょうか?
>なぜtotalの値を2で割るのか?
>そしてcntと比較されるのか?

条件②半数以上は、「教諭」または「養護教諭」であること
という事でしたから、
全体の半数(total/2)よりも、「教諭」+「養護教諭」(cnt)の数が大きい事を示しています。

今気づきましたが、「以上」ですから "=<" とするべきでしたね。

If total / 2 =< cnt Then GoTo LABEL

[返信 2] Re : 基準を判定するマクロ(追加質問てらてら様)
投稿者 : ブラック職場     投稿日時 : 2025/01/25(Sat) 11:39:24
てらてら様。
お返事ありがとうございます。
条件②半数以上は、「教諭」または「養護教諭」であること
は、校長・教頭除いた条件でありまして、その場合計算式はどのような式がよいか、
お忙しいところ申し訳ないのですが、もしよろしければご指導いただけないでしょうか。
わかりにくい基準表でご迷惑をお掛けします。

[返信 3] Re : 基準を判定するマクロ(追加質問てらてら様)
投稿者 : てらてら     投稿日時 : 2025/01/25(Sat) 20:07:31
条件②
全体の数から「校長」または「教頭」の数を除いたうえで、
全体の半数以上は、「教諭」または「養護教諭」であること

これをコードに置き換えれば良いでしょう。

If total - (Range("I6") + Range("I7")) / 2 <= cnt Then GoTo LABEL

コードに書き換えられるような文章をまずイメージとして持ちましょう。

[返信 4] Re : 基準を判定するマクロ(追加質問てらてら様)
投稿者 : ブラック職場     投稿日時 : 2025/01/26(Sun) 00:16:23
てらてら様。
重ね重ねありがとうございます。
すいませんが、また質問させていただくかもしれませんがよろしくお願いします。

[返信 5] Re : 基準を判定するマクロ(追加質問てらてら様)
投稿者 : てらてら様へ     投稿日時 : 2025/01/28(Tue) 00:16:31
定員判定の部分を校長、教頭を除いた人数で判定したいので下記のようなコードを作成しました。

'定員
teiin = Range("I8") + Range("I9")
'コーチ、看護師が専従なら含める
If InStr(Range("J10"), "専従") > 0 Then teiin = teiin + 1
If InStr(Range("J11"), "専従") > 0 Then teiin = teiin + 1

Dim 必要人員 As Long
必要人員 = ((Range("I3") - 1) \ 5) + 1
If teiin < 必要人員 Then GoTo LABEL


定員11名以上の場合も、半数以上は「教諭」または「養護教諭」がいること。
としたいのですが、上記コードですと
①教諭(常勤) ②コーチ(専従) ③養護教諭(専従)の3名でも判定OKと出てしまいます。

すいません、アドバイスいただけないでしょうか。
お手数のときご助力いただけると幸いです。

[返信 6] Re : 基準を判定するマクロ(追加質問てらてら様)
投稿者 : てらてら     投稿日時 : 2025/01/28(Tue) 05:48:30
>定員判定の部分を校長、教頭を除いた人数で判定したいので下記のようなコードを作成しました。

これを考慮したコードがどこかにありますか?

>定員11名以上の場合も、半数以上は「教諭」または「養護教諭」がいること。

「半数以上は」がどこにも反映されていません。

>teiin = Range("I8") + Range("I9")
> ....... 
>If teiin < 必要人員 Then GoTo LABEL

上記のコードですと、教師と看護教諭の合計(teiin) と必要人員を比較している事になるので、
教師と看護教諭の合計(teiin) < 必要人員 でOKとなってしまいます。

自分で考えた条件式が合っているかどうかはデバッグしながら試行錯誤する事をお勧めします。
以下のページを参考にしてみてください。

https://help-vba.com/starting-debug/

[返信 7] Re : 基準を判定するマクロ(追加質問てらてら様)
投稿者 : ブラック職場     投稿日時 : 2025/01/28(Tue) 12:09:22
てらてら様。
お返事ありがとうございます。
たしかに「半数以上は」がどこにも反映されていなかったです。
てらてら様でしたら、どのようなコードを作成されますか?
考え方はどのようにされますか。

[返信 8] Re : 基準を判定するマクロ(追加質問てらてら様)
投稿者 : てらてら     投稿日時 : 2025/01/28(Tue) 21:21:09
今回のようなケースでは、まず定員判定の定義を固めて、仕様をはっきりさせてからからでないとコードは書けないでしょう。
今回のコードでは、NGの条件を並べていき、最後まで該当しなければOKというスタンスで書かれていますので、その考え方で進めてみてはいかがでしょう。

[返信 9] Re : 基準を判定するマクロ(追加質問てらてら様)
投稿者 : ブラック     投稿日時 : 2025/01/29(Wed) 17:07:38
てらてら様。
アドバイスありがとうございます。

当掲示板について
  • Excel VBA に関する掲示板です。Excel VBA に関する質問や疑問、それに対する解決方法など気軽に投稿してください。
  • 記事内ではHTMLのタグは使用できません。
  • 記事は一度投稿すると修正できません。内容を訂正したい場合は返信で対応してください。
  • Sub〜End Sub、Function〜End Function は自動的にプログラムコードとみなし、枠で囲って見やすくします。
  • Excel VBA とは関係ないことや、他人が不快に思うようなことなど、管理人が適当でないと判断した記事は削除する場合があります。
スポンサーリンク
返信入力フォーム
お 名 前  :
内  容   :

ステータス  :

認証コード  : キャプチャ画像 




( 処理日時 : 2025-02-07 23:08:19 )
タイトルとURLをコピーしました