[[20201203112610]]　『特定のセルに入力されるとメッセージ』（匿名）　ページの最後に飛ぶ

『特定のセルに入力されるとメッセージ』（匿名）

質問です。出張費精算用シートを作成中です。
知りたいのは土日の食費（朝・昼・夜）に入力があった際に確認メッセージがポップアップで出てはいを選択でそのまま継続。いいえを選択で入力を消去したいです。

まずE10から右へ日付が入ります（最大で31日）。
その下の行E11から右へ上の行参照で曜日が入ります。表示形式は月火水木金土日

20行目（E20）から右にに朝食、21行目に昼食、22行目に夕食が入ります。
食費の入力はリストで○のみを入力出来る様になっています。
単価×○の個数で合計を算出しています。

土日を挟む出張の場合、土日には食費が出ない為、入力ミス軽減のため土日に○が入力された際にメッセージボックスが出る仕様にしたいと考えております。
その際、内容によっては土日でも食費が出る場合があるので、確認メッセージのみではい、いいえで分岐出来る様にしたいです。

データの入力規則でと考えましたが、リストがすでに入っている為、新たに追加することが出来ません。
シート作成後にマクロで別ブックとして出力しているのでその際に確認メッセージを出してそのまま出力か処理を中断させるとゆう手もあると思うのですが、VBAは初心者な為、どの様にコードを追加すればいいかが分かりません。

初めて質問させて頂きますので、至らない点等あるかと思いますが、お力添えよろしくお願い致します。

＜使用 Excel：Excel2016、使用 OS：Windows10 ＞

＞マクロで別ブックとして出力している～とゆう手もあると思う
その路線で進めるなら、現状のコードを示された方がよいとおもいます。

＞行参照で曜日が入ります。表示形式は月火水木金土日
＞土日に○が入力された際にメッセージボックスが出る仕様にしたい
↑で進めるなら、WorkSheetのChangeイベントについて調べて見るとよいとおもいます。
なお、Changeイベントの場合、Targetが複数セルになることがあり得るのでその点も注意された方がよいです。
（現段階では、なにを言っているかわからないとおもいますが、後々引っかかりそうなので先に書いておきます）

（もこな２） 2020/12/03(木) 12:45

もこな2様
返信ありがとうございます。
現状のコードです。

Sub 出力（）
'氏名未入力時
If Worksheets("費用詳細").Range("B6").Value = "" Then
MsgBox ("氏名未入力です。"). vbExclamation, "確認"
Worksheets("費用詳細").Range("B6"). Select
Exit Sub
End If

'出張開始日未入力時
If Worksheets("出張届").Range("AJ11").Value = "" Then
MsgBox ("出張開始日未入力です。"). vbExclamation, "確認"
Worksheets("出張届").Range("AJ11").Select
Exit Sub
End If

'出張終了日未入力時
If Worksheets("出張届").Range("AJ16").Value = "" Then
MsgBox ("出張終了日未入力です。"). vbExclamation, "確認"
Worksheets("出張届").Range("AJ16"). Select
Exit Sub
End If

Dim wb As Workbook, fn As Strine, i As Long, temp

temp = ThisWorkbook. Path & "\" & Worksheets("費用詳細").Range("B6").Value & "_" & _
"出張届" & Format(Worksheets("出張届").Range("AJ11").Value, "yymmdd") & "〜" & _
Format (Worksheets("出張届").Range("AJ16").Value, "yymmdd")

fn = Dir (temp & ".xlsx")
If fn = "" Then
fn = temp & ".xlsx"
Else
Do While fn 〈〉""
i = 1 + 1
fn = Dir (temp & "_" & Format (i. "00") & ".xlsx")
Loop
fn = temp & "_" & Format (i, "00") & ".xlsx"
End If

Sheets (Array("出張届", "費用詳細")). Copy
Set wb = ActiveWorkbook
wb. Worksheets("費用詳細"). Buttons. Delete
wb. SaveAs fn
MsgBox "同フォルダ内へ出張届を新規作成しました。ファイルを閉じてそちらを使用して下さい。"
wb. Close False

End Sub

素人なりに作成したコードですので、読みにくい部分やおかしい所があると思いますが
よろしくお願い致します。

（匿名） 2020/12/04(金) 03:25

だいぶ時間が経ってしまったので、もう見ていないかもしれませんが一応。

土日に○が付いているかどうかは、例えば↓のようなコードでチェックが可能だとおもいます。

    Sub さんぷる()
        Dim MyRNG As Range
        Dim MSG As String
        Dim buf As String
        With ActiveSheet '←どのシートが判らなかったので暫定です。（適宜修正して試してください）
            For Each MyRNG In .Range("E10:AI10")
                If MyRNG.Value = "" Then Exit For

                If Weekday(MyRNG.Value, vbMonday) > 5 Then  '土日であるか判定
                    If WorksheetFunction.CountIf(Intersect(MyRNG.EntireColumn, .Rows("20:22")), "○") > 0 Then  'その【列】に○があるか判定定
                        If MSG <> "" Then MSG = MSG & vbLf

                        buf = ""
                        If .Cells(20, MyRNG.Column).Value = "○" Then buf = buf & "朝食・"
                        If .Cells(21, MyRNG.Column).Value = "○" Then buf = buf & "昼食・"
                        If .Cells(22, MyRNG.Column).Value = "○" Then buf = buf & "夕食・"

                        MSG = MSG & format(MyRNG.Value, "mm/dd(aaa) ：") & left(buf, Len(buf) - 1)
                    End If
                End If
            Next MyRNG
        End With

        If MSG <> "" Then
            If MsgBox(prompt:="以下の食卓費の計上は間違いありませんか？" & vbLf & vbLf & MSG, Buttons:=vbYesNo + vbQuestion) = vbNo Then
                MsgBox "修正してやりなおしてください"
                Exit Sub
            End If
        End If

        MsgBox "コピー（転記）処理に進んでOK"

    End Sub

処理の流れとしては

 (1)必須項目の漏れチェック
 (2)計上が必要なのかチェック　←　追加
 (3)コピー（転記）処理

といったことになるとおもうんですが、率直な感想として(1)、(2)は条件付き書式で十分のように思えるのですよね・・・・

（もこな２） 2020/12/10(木) 19:02

コメント返信：

[ 一覧(最新更新順) ]

[[20201203112610]] 『特定のセルに入力されるとメッセージ』（匿名） ページの最後に飛ぶ

[[20201203112610]]　『特定のセルに入力されるとメッセージ』（匿名）　ページの最後に飛ぶ