[[20200719165227]] 『Msg Boxのコメントプレビューが出来ない為』(謙治) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『Msg Boxのコメントプレビューが出来ない為』(謙治)

kLY様、
先ほどの続きでコメントプレビューが出来ない為に新規で依頼しました。
すみません。

先ほどのコメントで、大変失礼しました。

 エラーが出たのは、?…と聞かれたので、
 当然、私がどこかで間違ったやり方をしているの
 かと思って見て頂きたいと思って記載しました。
 それをKLYさまのコードが悪いとは、 全然思っていません。

 本当は、チオチモリン様から聞かれた時は、
 KLY様からのマクロ登録不具合の返事を待って
 いますと言いたかったのです。でも
 質問されたので無視できなかったのです。
 本当に申し訳ありませんが、
 もう一度チャンスをください。

会社の事務合理化に繋がるのです。

 何卒よろしくお願いいたします。

< 使用 アプリ:エクセル365、使用 OS:Windows10 >


昔から、名前変えたり(女性の名前が多い)のらりくらりと
システムを作ってもらおうとする根性は変わりませんね。
(メメ) 2020/07/19(日) 17:28

ボタンを右クリックしてマクロ登録を選択したときにでるマクロ名を教えて下さい。
(KLY) 2020/07/19(日) 17:46

KLY様
有難うございます。

マクロ名の下の枠ですね。

Sheet1,さんぷる壱です。

(謙児) 2020/07/20(月) 00:10


メメさん
もっと広い心で接しましょうよ。
せかせかしすぎっすよ
(ニーア) 2020/07/20(月) 02:55

横から失礼。
 
[[20200715051835]]にチオチモリンさんからコメントがありますように、
単に「マクロの登録」が更新できていないだけの話ですね。
コードをいくら書き換えても、
ボタンに登録されているマクロ名が昔のままということです。
その下にあるマクロ名の選択肢から、
「セル移動」を選択して「OK」ボタンをおせばよいだけです。

どうしてこういうことで大騒ぎになるのか、不思議ですし、
上記を淡々と報告するだけで、事実に驚愕するといったことはないのでしょうか。

(γ) 2020/07/20(月) 06:00


皆様の言われる通りです。お腹立ちはごもっともです。すみませんでした。

>コードをいくら書き換えてもボタンに登録されているマクロ名が昔のままということです。
最初は、コードを置き換えたらボタンを押しただけで登録しなおされると思っていました。

KLY様から
>ボタンを右クリックしてマクロ登録を選択したときにでるマクロ名を教えて下さい。
Sheet1,さんぷる壱ですと答えようとしたときに、チオチモリンさんから20200715051835]]の
コメントが入っていました。

それをみて、修正しました。ボタンをクリックしてうまく行きました。
マクロ名の選択肢名前を変えないと、変わらない事が修正して気づきました。

そこでKLY様の質問に対してチオチモリンさんからのコメントでわかりましたと伝えようと
本当に思ったのですが、迷いました。
それは、
KLY様に失礼な事をしたにも拘わらず、再度質問を頂いたので有りがたく、そこを大事にしたかったので
KLY様からチオチモリンと同様の回答を受けたあとで、直りましたと伝えたかったのです。

今後、気をつけます。
KLY様にも迷惑ばかりかけて申し訳ありませんでした。

(謙児) 2020/07/20(月) 07:03


↑のコメントをみて疑います。私はここまでとします。

(KLY) 2020/07/20(月) 10:22


KLY様
私の必要以上の気遣いと知識無さが生んだものと反省しています。
何とか便利なユーザーフォームを是非作成して頂きたいので
よろしくお願いいたします。
(謙治) 2020/07/20(月) 11:58

お断りいたします。
(KLY) 2020/07/20(月) 14:16

遡って読むのが面倒なので
何をしたいか、改めて説明できますか。
現状のコードと、それで何が問題なのかも。

(マナ) 2020/07/20(月) 22:19


マナ様
有難うございます。
>何をしたいか、改めて説明できますか。
下記、■の2点です。

>現状のコードと、それで何が問題なのかも。
現状のコードを記載します。
転記ボタンには、マクロ登録を正しくしましたので問題はありません。

■下記現状のコードにおきまして、C6(MsgBox "請求書の支払合計が未入力です。)以降次の
各MsgBoxで、---が未入力ですがと出ましたら、入力すれば、MsgBox、請求月は、
当月締め日になっていますか?"に戻らずに、次の未入力欄のMsgBoxに進み
入力が終われば、更に次の未入力欄のMsgBoxに進み入力後、全て入力されたならば、sheet名"弥生会計へ
転記"に進むコードを教えて頂きたいのです。

■ユーザーフォーム(こういう入力には、大変便利と聞いていましたので)を教えて頂きたいのです。
しかしネットでユーザーフォーム検索して調べましたら、色々な関連性を理解しなければ
ならないので素人には難しいと書いていました。 
今までも、些細なことで私が知識がない為に、同じ事を長々とやり取りしましたから

ユーザーフォームにしても、これ以上ご迷惑をかけるような同じことを繰り返したくないので、
難しいようであれば諦めます。


現状のコードは、下記に記載します。
Sub セル移動()
Application.ScreenUpdating = False

        Dim MyRNG As Range
        Dim i As Long

 Sheets("請求書入力").Select
 Range("C3").Select
 If Range("C3") = "" Then
   MsgBox ("担当名が未入力です。" & Chr(13) & "確認して下さい")
   Exit Sub
 End If

 Range("C4").Select

 If Range("C4") = "" Then
    MsgBox "支払先名が未入力です。" & Chr(13) & "確認して下さい"
    Exit Sub
 End If

 Range("C5").Select

 If Range("C5") = "" Then
    MsgBox "請求書年月日が未入力です。" & Chr(13) & "確認して下さい"
    Exit Sub
 End If

 Dim 確認

 If Range("C5") <> "" Then
    確認 = MsgBox("請求月は、当月締め日になっていますか?", vbYesNo)
       If 確認 = vbYes Then
          Range("C6").Select
       Else
         Exit Sub
       End If
 End If

 If Range("C6") = "" Then
    MsgBox "請求書の支払合計が未入力です。" & Chr(13) & "確認して下さい"
    Exit Sub
 End If

 Range("D6").Select

 If Range("D6") <> o Then
    MsgBox "支払金額と各勘定科目の金額に差額が出ています。" & Chr(13) & "確認して下さい"
    Exit Sub
 End If

 Range("B10").Select

 If Range("B10") = "" Then
    MsgBox "?@の勘定科目等が未入力です。他の勘定科目等の漏れはないですか?" & Chr(13) & "確認して
下さい"
    Exit Sub
 End If

 Range("B13").Select

 If Range("B13") = "" Then
    MsgBox "税込み金額が未入力です。" & Chr(13) & "確認して下さい"
    Exit Sub
 End If

 Range("B14").Select

 If Range("B14") = "" Then
    MsgBox "?@の支払明細が未入力です。他の支払い明細の、漏れはないですか?" & Chr(13) & "確認して
下さい """
    Exit Sub
 End If

'▼""じゃなかったらその行を覚える

        With Worksheets("請求書入力").Range("A37:Y42")
            For i = 1 To .Rows.Count
                If .Cells(i, 1).Value <> "" Then
                    If MyRNG Is Nothing Then
                        Set MyRNG = .Rows(i)
                    Else
                        Set MyRNG = Union(MyRNG, .Rows(i))
                    End If
                End If
            Next i
        End With

        '▼覚えたセル範囲があったらコピペする
        If Not MyRNG Is Nothing Then
            MyRNG.Copy
            Sheets("弥生会計へ転記").Range("a1000").End(xlUp).Offset(1). _
             PasteSpecial Paste:=xlPasteValuesAndNumberFormats, _
                    Operation:=xlNone, _
                    SkipBlanks:=False, _
                    Transpose:=False

                Application.CutCopyMode = False

        End If

        '支払別への転記

             '▼""じゃなかったらその行を覚える
        With Worksheets("請求書入力").Range("A37:aa42")
            For i = 1 To .Rows.Count
                If .Cells(i, 1).Value <> "" Then
                    If MyRNG Is Nothing Then
                        Set MyRNG = .Rows(i)
                    Else
                        Set MyRNG = Union(MyRNG, .Rows(i))
                    End If
                End If
            Next i
        End With

     '▼覚えたセル範囲があったらコピペする
        If Not MyRNG Is Nothing Then
            MyRNG.Copy
            Sheets("支払別").Range("a1000").End(xlUp).Offset(1). _
             PasteSpecial Paste:=xlPasteValuesAndNumberFormats, _
                    Operation:=xlNone, _
                    SkipBlanks:=False, _
                    Transpose:=False

                Application.CutCopyMode = False

     End If

     Sheets("請求書入力").Activate
  Sheets("請求書入力").Range("c2").Select

  Application.ScreenUpdating = True

End Sub

以上です、よろしくお願いいたします。

(謙児) 2020/07/21(火) 08:36


請求月は、当月締め日になっていますか? のIf〜End Ifを
すべての未入力、差額チェックが終わった後に移動すればいいのでは?

1回はいと答えたら、下のチェックで引っかかっても、2回は聞いてこない
ようにしたいのなら、チェックを通過した最後に聞けば。
(cai) 2020/07/21(火) 09:18


Sub セル移動() を元の Sub さんぷる壱() に変更せよ。
(KLY) 2020/07/21(火) 09:50

 >今までも、些細なことで私が知識がない為に、同じ事を長々とやり取りしましたから
 >ユーザーフォームにしても、これ以上ご迷惑をかけるような同じことを繰り返したくないので、 
 難しいようであれば諦めます。
 VBE について知識を身に付けることが先です。諦めましょう。
(閲覧者) 2020/07/21(火) 10:01

cai様
解答、有難うございます。
早くから回答して頂きすみませんでした。
今、出先から帰って見ています。

>請求月は、当月締め日になっていますか? のIf〜End Ifを
>すべての未入力、差額チェックが終わった後に移動すればいいのでは?
そのコードを最後に入れ替えました。あえて全部未入力にして試すと
各未入力を埋めると最後に"当月締め日になっていますか?"で、はいを選べば

 Sheets("弥生会計へ転記")へ行きました。有難うございます。

しかし、いいえ を選べば、締日をいれてもそのままの状態で
Sheets("弥生会計へ転記")へ行きません。

下のコードで("C5")が未入力の場合、入力したのちに

 With Worksheets("請求書入力").Range("A37:Y42")に続くようにしたいのですが、
何のコードでつないだら宜しいですか?教えてください。もう一歩なのです。

If Range("C5") <> "" Then

    確認 = MsgBox("請求月は、当月締め日になっていますか?", vbYesNo)
      If 確認 = vbYes Then
      ’Range("C6").Select
      Else
      Exit Sub
      End If
  End If

'▼""じゃなかったらその行を覚える

  With Worksheets("請求書入力").Range("A37:Y42")

(謙児) 2020/07/21(火) 15:21


Sub セル移動() を元の Sub さんぷる壱() に変更せよ。

(KLY) 2020/07/21(火) 15:25


横からすみません。
過去のやり取り含め眺めてみましたが、
質問者さんの希望を叶えるには
もこな2さんのアドバイスにあったStatic変数を使うか
どこかのセルに「フラグを立てる(「請求月は、当月締め日になっていますか?」について回答済みなら何かの値を記入して、そのセルが空白でない場合はその質問をスキップする)」しかないと思います。

もこな2さんへは「難しくて理解できなかった」という回答をなさっていたので
これはもしかしたら質問者さんには難しすぎる内容なのかもしれません。
頑張って理解するか、諦めるかの2択になるだろうと思います。
(苫) 2020/07/21(火) 15:32


衝突しました。
KLY様
Sub セル移動() を元の Sub さんぷる壱() に変更せよ。 すみませんでした。
言われるように下記のように変更しました。

cai様
上記質問のコードを下記のように変更します。
If Sheets("請求書入力").Range("c5") <> "" Then

    If MsgBox("請求月は、当月締め日になっていますか?", vbYesNo) = vbNo Then
        Exit Sub
    End If
   End If

 With Worksheets("請求書入力").Range("A37:Y42")
            For i = 1 To .Rows.Count
                If .Cells(i, 1).Value <> "" Then
                    If MyRNG Is Nothing Then
                        Set MyRNG = .Rows(i)
                    Else
                        Set MyRNG = Union(MyRNG, .Rows(i))
                    End If
                End If
            Next i
        End With
(謙児) 2020/07/21(火) 15:49

 >Sub セル移動() を元の Sub さんぷる壱() に変更せよ。 すみませんでした。 
 言われるように下記のように変更しました。
 おまえは本当に馬鹿だな。よく見てみろ誰がコードをを変更しろといった。怒りに怒り
(KLY) 2020/07/21(火) 16:15

KLY様
前に、KLY様が、私のコードが間違っていると言われているみたいというような
事を言われたので、

>Sub セル移動() を元の Sub さんぷる壱() に変更せよ。

 (KLY) 2020/07/21(火) 09:50 

セル移動() の一部をcai様に表示した時に、
>Sub セル移動() を元の Sub さんぷる壱() に変更せよ。
(KLY) 2020/07/21(火) 15:25
と2回とも私のコードは、使ってほしくない だから早くさんぷる壱()のコード に全て入れなおして
ほしいと言っているかと思いましたので、cai様に表示しました"C6"も入れ替えてほしいと
思っていると思いました。

そこでKLY様が作られた下記コードをさんぷる壱() コードに入替えただけです。
確認 = MsgBox("請求月は、当月締め日になっていますか?", vbYesNo)

      If 確認 = vbYes Then
      ’Range("C6").Select
      Else
      Exit Sub
      End If
  End If

■>Sub セル移動() を元の Sub さんぷる壱() に変更せよ。
改めてですが、コードの最初に sub さんぷる壱 と書き換えるだけの事を言っているのでしょうか?
(謙児) 2020/07/21(火) 17:17


 >改めてですが、コードの最初に sub さんぷる壱 と書き換えるだけの事を言っているのでしょうか?
 そうだよ。コードもマクロ名も一緒にするんじゃねえよ。あほったれ
 マクロについてしっかり勉強しろ
(KLY) 2020/07/21(火) 17:49

KLY様
はい、わかりました。有難うございます。
(謙児) 2020/07/21(火) 18:22

kLYさん、いくら何でも言いすぎですよ。昨今ネットで誹謗中傷が議論になっている世の中でこれは暴言ですよ。謙児さんが傷つきますよ。
(も二な2) 2020/07/21(火) 21:51

 2009年前から、Excel VBAのサロンでこんな感じだったけど。
 どう判断するのかは解りません。
(メメ) 2020/07/21(火) 21:59

 >コードが走る為に「請求月は、当月締め日になっていますか?」と出ます。 
 入力する人は、また同じ文言が出ている、また、はいと押さなければなら 
 ないとわずらしさを感じるためです。)
 は当初の記述
 >■下記現状のコードにおきまして、・・・・
 は上記のことを言っているんですよね。
 >各MsgBoxで、---が未入力ですがと出ましたら、入力すれば、MsgBox、請求 月は当月締め日になっていますか?"に戻らずに、
 次の未入力欄のMsgBoxに進み・・・・・全て入力されたならば
 回りくどい書き方をししているので見るのにも疲れるし他の方にはわかりずらいです。
 またMsgBox、請求月は・・・・の確認箇所も指定していないですね。
 「全て入力したら最後にMsgBox、請求月は、当月締め日になっていますか?"で確認して次に進む。」
 これだけで簡潔になりますよ。

 (cai) 2020/07/21(火) 09:18さんのを参考にKLYさんに断りもなくコード改変させてもらいました。
 使用については自由にどうぞ。

 このまま実行するとエラーになります。
 >Range("D6") <> o のところでエラーになります。設定がおかしいです。
 KLYさんのコメントです。
 私もエラーになったので数字の 0 に置き換えて実行してみました。
 結果は下の表を見てください。

 Sub さんぷる壱()
Application.ScreenUpdating = False
Dim MyRNG As Range
Dim i As Long
Sheets("請求書入力").Select
Range("C3").Select
If Range("C3") = "" Then
   MsgBox ("担当名が未入力です。" & Chr(13) & "確認して下さい")
Exit Sub
End If
Range("C4").Select
If Range("C4") = "" Then
   MsgBox "支払先名が未入力です。" & Chr(13) & "確認して下さい"
Exit Sub
End If
Range("C5").Select
If Range("C5") = "" Then
   MsgBox "請求書年月日が未入力です。" & Chr(13) & "確認して下さい"
Exit Sub
End If
※ここに追加する
If Range("C6") = "" Then
   MsgBox "請求書の支払合計が未入力です。" & Chr(13) & "確認して下さい"
Exit Sub
End If
Range("D6").Select
If Range("D6") <> o Then
   MsgBox "支払金額と各勘定科目の金額に差額が出ています。" & Chr(13) & "確認して下さい"
Exit Sub
End If
Range("B10").Select
If Range("B10") = "" Then
   MsgBox "?@の勘定科目等が未入力です。他の勘定科目等の漏れはないですか?" & Chr(13) & "確認して下さい "
Exit Sub
End If
Range("B13").Select
If Range("B13") = "" Then
   MsgBox "税込み金額が未入力です。" & Chr(13) & "確認して下さい"
Exit Sub
End If
Range("B14").Select
If Range("B14") = "" Then
   MsgBox "?@の支払明細が未入力です。他の支払い明細の、漏れはないですか?" & Chr(13) & "確認して下さい"
Exit Sub
End If
Dim 確認
If Range("C5") <> "" Then
   確認 = MsgBox("請求月は、当月締め日になっていますか?", vbYesNo)
      If 確認 = vbNo Then
         Range("C5").Select
         Exit Sub
      Else
         Worksheets("請求書入力").Select
      End If
End If
'▼""じゃなかったらその行を覚える
With Worksheets("請求書入力").Range("A37:Y42")
For i = 1 To .Rows.Count
If .Cells(i, 1).Value <> "" Then
   If MyRNG Is Nothing Then
      Set MyRNG = .Rows(i)
   Else
      Set MyRNG = Union(MyRNG, .Rows(i))
   End If
End If
Next i
End With
'▼覚えたセル範囲があったらコピペする
If Not MyRNG Is Nothing Then
   MyRNG.Copy
   Sheets("弥生会計へ転記").Range("a1000").End(xlUp).Offset(1). _
   PasteSpecial Paste:=xlPasteValuesAndNumberFormats, _
   Operation:=xlNone, _
   SkipBlanks:=False, _
   Transpose:=False
   Application.CutCopyMode = False
End If
'▼""じゃなかったらその行を覚える
With Worksheets("請求書入力").Range("A37:aa42")
   For i = 1 To .Rows.Count
      If .Cells(i, 1).Value <> "" Then
         If MyRNG Is Nothing Then
         Set MyRNG = .Rows(i)
         Else
         Set MyRNG = Union(MyRNG, .Rows(i))
         End If
      End If
Next i
End With
'支払別への転記
 '▼覚えたセル範囲があったらコピペする
If Not MyRNG Is Nothing Then
   MyRNG.Copy
   Sheets("支払別").Range("a1000").End(xlUp).Offset(1). _
   PasteSpecial Paste:=xlPasteValuesAndNumberFormats, _
   Operation:=xlNone, _
   SkipBlanks:=False, _
   Transpose:=False
   Application.CutCopyMode = False
End If
Sheets("請求書入力").Activate
Sheets("請求書入力").Range("c2").Select
Application.ScreenUpdating = True
End Sub

 請求書入力シート
     |[A]|[B]|[C]|[D]|[E]|[F]|[G]|[H]|[I]|[J]|[K]|[L]|[M]|[N]|[O]|[P]|[Q]|[R]|[S]|[T]|[U]|[V]|[W]|[X]|[Y]|[Z]|[AA]
 [37]|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd 
 [38]|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd 
 [39]|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd 
 [40]|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd 
 [41]|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd 
 [42]|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd 

 弥生会計へ転記シート
     |[A]|[B]|[C]|[D]|[E]|[F]|[G]|[H]|[I]|[J]|[K]|[L]|[M]|[N]|[O]|[P]|[Q]|[R]|[S]|[T]|[U]|[V]|[W]|[X]|[Y]
 [2] |asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd
 [3] |asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd
 [4] |asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd
 [5] |asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd
 [6] |asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd
 [7] |asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd
 [8] |asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd
 [9] |asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd
 [10]|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd
 [11]|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd
 [12]|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd
 [13]|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd
 [14]|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd
 [15]|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd
 [16]|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd
 [17]|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd
 [18]|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd
 [19]|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd

 支払別シート
     |[A]|[B]|[C]|[D]|[E]|[F]|[G]|[H]|[I]|[J]|[K]|[L]|[M]|[N]|[O]|[P]|[Q]|[R]|[S]|[T]|[U]|[V]|[W]|[X]|[Y]|[Z]|[AA]
 [2] |asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|   |    
 [3] |asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|   |    
 [4] |asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|   |    
 [5] |asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|   |    
 [6] |asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|   |    
 [7] |asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|   |    
 [8] |asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd 
 [9] |asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd 
 [10]|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd 
 [11]|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd 
 [12]|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd 
 [13]|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd 
 [14]|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd 
 [15]|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd 
 [16]|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd 
 [17]|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd 
 [18]|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd 
 [19]|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd|asd 
(閲覧者) 2020/07/21(火) 22:57

 閲覧者さん手助けありがとう。
 >KLYさんに断りもなく
 そんなことないです。
(KLY) 2020/07/21(火) 23:21

衝突しました。

閲覧者様
以前のコメントを精査していただき、ここに解答して頂き
有難うございます。

>「全て入力したら最後にMsgBox、請求月は、当月締め日になっていますか?"で確認して次に進む。」
> これだけで簡潔になりますよ。
はい、わかりました。

閲覧者様の上記コード(Sub さんぷる壱()から)を全て入れ替えました。
基本、上記3つのシートのようになります。3つのシート行、列(各最後の列は、その通りです。)
私にわかるように沢山記載して頂き有難うございました。

全て入力したら、最後にMsgBox、請求月は、当月締め日になっていますか?"で
確認した時に日付が正しい場合に、"はい"をクリックすればシート名:
弥生会計へ転記されます。

しかし、日付が間違っていたと仮定して"いいえ"ボタンをクリックして正しい
日付に入れ替えたあとは、止まったままでシート名:弥生会計へ転記され
ません。
ここがどうすればいいのかを知りたかったのです。

よろしくお願いいたします。

(謙児) 2020/07/22(水) 00:08


閲覧者様

2020/07/22(水) 00:08の上記で私が述べました
>ここが知りたかったのです。とは---
正しい日付に入れ替えた後、止まりますが、
そこで、例えば日付を入れた後でエンターキーを押せば、
シート名:弥生会計へ転記されるというようなことを望んでいました。
(それがうまく走りますと、各MsgBoxで未入力が出た時に、入力後、いちいち
ボタンを押さなくても次のMsgBoxに移っていけることに利用できるかと思って
いました。)

しかしそのような事が私にとって難しいのであれば、入力者に、各メッセージ
が出れば、その都度ボタンを押して下さいと伝えます。

(謙児) 2020/07/22(水) 06:02


一回ボタン押したら、次次と、、、 でしたら

チェックに引っかかったら入力を求めればよいのでは??

Range("C3").Select
If Range("C3") = "" Then

   MsgBox ("担当名が未入力です。" & Chr(13) & "確認して下さい")
    msg = "担当名が未入力です。" & vbCrLf & _
          "ここに担当者名を入力してください。"
    buf = InputBox(msg)
    Range("C3") = buf
End If
(サンダー) 2020/07/22(水) 07:19

 >しかし、日付が間違っていたと仮定して"いいえ"ボタンをクリックして正しい 
 >日付に入れ替えたあとは、止まったままでシート名:弥生会計へ転記されません。 
 >ここがどうすればいいのかを知りたかったのです。
 >そこで、例えば日付を入れた後でエンターキーを押せば、
 日付訂正入力後エンターキーを押さないで直接ボタンを押してください。
 メッセージが出たらはいを押すと弥生会計へ → 支払別へと進行します。

 ※ Range("C6").Select のコードが抜けていました。上記のコードを参照してください。
(閲覧者) 2020/07/22(水) 09:03

謙児さん
とういか、会社のシステムをネットの第3者に作ってもらうってセキュリティー的に
大丈夫ですか?会社の規約的にまずくないですか?
(逸脱) 2020/07/22(水) 10:40

衝突しました。
今見ますと、逸脱様からのコメントが先に入っていました。
逸脱さま
コメント、有難うございます、ご心配をおかけしてすみませんでした。
>会社の規約的にまずくないですか?
大丈夫です。
コンプライアンス上も担当者名、支払先名、明細等、個人情報をネットの第3者にお伝えしていませんので
自分自身で作成したものと同等な考えだと思っています。

むしろコロナウイルス感染の折、事前に予算をとっていました経費精算ソフトが買えなくなって
それに替わるものが出来ましたら会社として喜びです。

しかし言ってもらった事を頭に入れて置きます。
有難うございました。


下記は衝突する前にアップしたものです。

サンダー様
早速ご回答を頂き有難うございます。

私自身、未入力が終わって違うシートに転記される方法はないものかと思って
サイトでMsgBoxについて色々調べていましたら、サンダー様が提示して
いただいたインップトボックスもありました。こういう便利な使い方も
あるんだなあと思いましたが、今のデータは、入力者に手を
わずらわせたくないので、リストボックスから選んで自動入力をしています。

サンダー様の提示されたコードを参考に全てのMsgBoxを入替えてボタンを
押して確認をしましたが、インプットボックスに入力する時にリストボックス
から選択できませんでした。

当該のデータでは利用しがたいですが、他に活用出来そうなもの
(そもそも登録できないもの)がありそうな感じがしますので、インプット
ボックスのコードを活かしたいと思います。
有難うございます。

閲覧者様
お返事、有難うございます。

>日付訂正入力後エンターキーを押さないで直接ボタンを押してください。
>メッセージが出たらはいを押すと弥生会計へ → 支払別へと進行します。
はい、承知いたしました。

>※ Range("C6").Select のコードが抜けていました。上記のコードを参照し
てください。
追加しましたが、その前にボタンを実行したときに、追加しなくとも請求書の
支払合計が未入力になっていた場合にMsgBoxでc6が未入力と出ていま
した。でも基本、記載すべき箇所なのですね。

*何回お伝えしても自分の思いが伝わらないから、わかって頂こうと順番に
説明したことが、かえってまどろこしいと教えて頂き
(私も前に記載しているのに再度順を追って記載するのは長ったらしいと
 思っていました。)有難うございました。

 これからは、シンプルで理解しやすい文章を作成するように心がけます。

他の方々様も足らない私に色々アドバイスを頂き感謝しています。
有難うございました。

(謙児) 2020/07/22(水) 11:09


 >でも基本、記載すべき箇所なのですね。
 そうです。
 こちらで再度確認したところメッセージと入力位置がずれていくことが判明しましたので。
(閲覧者) 2020/07/22(水) 11:37

閲覧者さま、
ありがとうございます。
(謙治) 2020/07/22(水) 11:58

うーん、外注せずしてネット匿名掲示板でシステム開発ですかー
コンプライアンス的にもおkですか。顧客的には・・どうなんですかね…
(逸脱) 2020/07/22(水) 12:09

逸脱様
コメント、有難うございます。

>とういか、会社のシステムをネットの第3者に作ってもらうってセキュリティー的に
>大丈夫ですか?会社の規約的にまずくないですか?
> (逸脱) 2020/07/22(水) 10:40
上記の件で、ふっと後で思い逸脱さまに確認をとろうとしました時に
逸脱さまからコメントが届いていました。
■私の質問は、セキュリティー的に大丈夫ですか?と問われているということは、私が、ネット上で操作しなくても質問者は、情報を取れるのでしょうか?
ということでした。

ここで私がコンプライアンス上、大丈夫と言いましたのは、セキュリティー的
にクラウドとかネット上で操作していないので個人情報の漏えいはありません
という思いで伝えました。。
逸脱様の言っておられることを読み取れていなかったように思います。
すみませんでした。

>むしろコロナウイルス感染の折、事前に予算をとっていました経費精算ソフ
トが買えなくなって
>それに替わるものが出来ましたら会社として喜びです。
正直に記載したのですが、書かなかったらよかったですね。
経費精算ソフトは、多機能であり、利便性があり、各承認も担当者から自動的
に上司から経理へとつながるようになっています。

私どもは、そんな高価なものはいらないのでコロナウイルス感染前から上司と共に躊躇していました。結果コロナウイルス感染による売上減からソフト購入
の考えは、やめようと決まりました。では、代わりに事務の合理化を目指し、
自分で一度挑戦しようと思い 昔、作成していたリストボックスとMsgBox
を思い出し、それらのファイルを出して、それらをいろんな箇所に作りました
が、実態に合わすと途中にちょっとしたところで思うように行かず、
うまく走らなくなりましたので、直す方法がわからず、
質問をさせていただきました。その質問の回答に理解不足から時間を
とらせまして申し訳なく思っています。

何もないところから開発するために教えて頂いたものではありませんので
誤解無きようにお願いいたします。。

最初から何もせずに、システム開発を依頼したのであれば、

うーん、外注せずしてネット匿名掲示板でシステム開発ですかー コンプライアンス的にもおkですか。顧客的には・・どうなんですかね… というお気持ちは十分理解できます。

>注せずしてネット匿名掲示板でシステム開発ですかー。
どうぞこの件につきましては寛大なお心で対処して頂けますか?

補足ですが、
*現状は、経理担当者一人が会計ソフトに各部署の請求書を入力します。
 月次が締まる時間が遅くなるので、請求書のみ各担当者に入力して頂こうと
 考えました。
 そのデータを会計ソフトの基準に合わせてインポートするというやり方を
 考えました。

以上ですが、長々と記載して申し訳ございませんでした。

(謙児) 2020/07/22(水) 14:30


 入力作業の流れが、イメージに合わないなぁ。。

 通常の入力は

 (1) 必要なセルに入力する。(ミス以外は、いちいちプログラムで指摘しなくても分かることである)
   その際、セルの移動は、C3→C4→C5→B10→B13→B14 の順となる。

   しかし、C3からC5、B13からB14は自然体で移動するので、何もすることはない。

   なので、C5→B10→B13への移動を自動的になるように塩梅すればいい。
   自動移動は、Changeイベントを利用する。

 (2)その後、転記用のボタンをクリックする
   ここで、入力データのチェックを行い、問題があれば、
   当該セルをSelectして、入力を促す。   
   操作者は、不備を補足入力後、再度転記ボタンを押す。

 (3)全て問題がなければ、この最終確認をして、転記実行となる
              ↓
   「請求月は、当月締め日になっていますか?」

 以下疑問点
  D6セルに差額が出るようですけど、ここは数式で出しているんでしょうから、
  D6セルをSelectする必要は無いハズ。

(半平太) 2020/07/22(水) 15:21


半平太さま
有難うございます。

>その際、セルの移動は、C3→C4→C5→B10→B13→B14 の順となる。
C5の次にC6(請求書の支払合計を入力)もあります。

>(1)は、なるほどと思いました。

>(2)その後、転記用のボタンをクリックする

   ここで、入力データのチェックを行い、問題があれば、
   当該セルをSelectして、入力を促す。   
>  操作者は、不備を補足入力後、再度転記ボタンを押す。
   不備をまとめて入力するのですね。一度にまとめてできますね。

> 以下疑問点

  D6セルに差額が出るようですけど、ここは数式で出しているんでしょうから、
>  D6セルをSelectする必要は無いハズ。
  D6の計算式は、C6(請求書の支払合計を入力)−C7(各勘定科目の
  各金額を自動合計しています。)もし差額が出てD6に気付かなかったら
  誤った金額が転記されますので
  メッセージを出して確認をすれば入力間違いがなくなると思っただけで
  す。入力者が  自動計算を見て頂ければD6セルをSelectする必要が
  ないと思います。

(謙児) 2020/07/22(水) 16:22


 >C5の次にC6(請求書の支払合計を入力)もあります。
 見落としました。

 >>  操作者は、不備を補足入力後、再度転記ボタンを押す。
 >   不備をまとめて入力するのですね。一度にまとめてできますね。
 ここがちょっと疑問なんですけど、入力する人は大人ですよね。
 そんなに、あれもこれも入力し忘れますか?

 一度にまとめて修正入力するような仕掛けを(手間を掛けてまで)考える必要はないと思います。
 一つミスを修正入力させて、転記ボタンを押させればいいと思います。

 せいぜい「何と何(全○件)が未入力です。確認してください」と出すくらいでいいんじゃないですか?

 >> D6セルに差額が出るようですけど、ここは数式で出しているんでしょうから、
 >> D6セルをSelectする必要は無いハズ。
 >  D6の計算式は、C6(請求書の支払合計を入力)−C7(各勘定科目の
 >  各金額を自動合計しています。)もし差額が出てD6に気付かなかったら
 >  誤った金額が転記されますので
 >  メッセージを出して確認をすれば入力間違いがなくなると思っただけで
 >  す。入力者が  自動計算を見て頂ければD6セルをSelectする必要がないと思います。

 まず、D5のセルが0じゃない場合、D5セルには条件付き書式で
 赤く塗りつぶす様にして置けばいいと思います。
 その状態で、転記ボタンを押す人は滅多にいないでしょう。

 もっとも、絶対居ない訳じゃないので、入力データの総合チェックの過程では、
 警告対象にはすることになりますけども。

(半平太) 2020/07/22(水) 18:13


半平太様
>一つミスを修正入力させて、転記ボタンを押させればいいと思います。
そのようにさせて頂きます。

>そんなに、あれもこれも入力し忘れますか?
同じ人があれもこれも入力し忘れは、しないと思いますが、
A氏、B氏、C氏がそれぞれ違う項目で未入力がある場合を想定して各入力
項目にMsgBoxを入れました。

>まず、D5のセルが0じゃない場合、D5セルには条件付き書式で
>赤く塗りつぶす様にして置けばいいと思います。
それは、いいアイデアですね。賛成です。

>その状態で、転記ボタンを押す人は滅多にいないでしょう。
そうですね。

(謙児) 2020/07/22(水) 19:11


 >>一つミスを修正入力させて、転記ボタンを押させればいいと思います。
 >そのようにさせて頂きます。

 >>まず、D5のセルが0じゃない場合、D5セルには条件付き書式で
 >>赤く塗りつぶす様にして置けばいいと思います。
 >それは、いいアイデアですね。賛成です。

 ならば以下のコードで。※条件付き書式はそちらで設定してください。

 Sub セル移動()
    Dim MyRNG As Range
    Dim i As Long
    Dim 確認
    Dim adrAry
    Dim msg As String
    Dim Suffix As String

    Suffix = Chr(13) & "確認して下さい"
    adrAry = Array("C3", "C4", "C5", "C6", "B10", "B14")

    Rem 未入力セルのチェック
    If Range("C3") = "" Then
        msg = "0-担当名が未入力です。" & Suffix
    ElseIf Range("C4") = "" Then
        msg = "1-支払先名が未入力です。" & Suffix
    ElseIf Range("C5") = "" Then
        msg = "2-請求書年月日が未入力です。" & Suffix
    ElseIf Range("C6") = "" Then
        msg = "3-請求書の支払合計が未入力です。" & Suffix
    ElseIf Range("B10") = "" Then
        msg = "4-(1)の勘定科目等が未入力です。他の勘定科目等の漏れはないですか?" & Suffix
    ElseIf Range("B14") = "" Then
        msg = "5-(1)の支払明細が未入力です。他の支払い明細の、漏れはないですか?" & Suffix
    End If

    If msg <> "" Then '未入力あり
        MsgBox Right(msg, Len(msg) - 2)
        Range(adrAry(Val(Left(msg, 1)))).Select
        Exit Sub
    End If

    Rem 差額チェック
    If Range("D6") <> 0 Then
        MsgBox "支払金額と各勘定科目の金額に差額が出ています。" & Suffix
        Exit Sub
    End If

    確認 = MsgBox("請求月は、当月締め日になっていますか?", vbYesNo)
    If 確認 <> vbYes Then
        Exit Sub
    End If

    Application.ScreenUpdating = False

    '▼""じゃなかったらその行を覚える
    With Worksheets("請求書入力").Range("A37:Y42")
        For i = 1 To .Rows.Count
            If .Cells(i, 1).Value <> "" Then
                If MyRNG Is Nothing Then
                    Set MyRNG = .Rows(i)
                Else
                    Set MyRNG = Union(MyRNG, .Rows(i))
                End If
            End If
        Next i
    End With

    '▼覚えたセル範囲があったらコピペする
    If Not MyRNG Is Nothing Then
        MyRNG.Copy
        Sheets("弥生会計へ転記").Range("a1000").End(xlUp).Offset(1). _
        PasteSpecial Paste:=xlPasteValuesAndNumberFormats, _
        Operation:=xlNone, _
        SkipBlanks:=False, _
        Transpose:=False
        Application.CutCopyMode = False
    End If

    '支払別への転記
    '▼""じゃなかったらその行を覚える
    With Worksheets("請求書入力").Range("A37:aa42")
        For i = 1 To .Rows.Count
            If .Cells(i, 1).Value <> "" Then
                If MyRNG Is Nothing Then
                    Set MyRNG = .Rows(i)
                Else
                    Set MyRNG = Union(MyRNG, .Rows(i))
                End If
            End If
        Next i
    End With

    '▼覚えたセル範囲があったらコピペする
    If Not MyRNG Is Nothing Then
        MyRNG.Copy
        Sheets("支払別").Range("a1000").End(xlUp).Offset(1). _
        PasteSpecial Paste:=xlPasteValuesAndNumberFormats, _
        Operation:=xlNone, _
        SkipBlanks:=False, _
        Transpose:=False
        Application.CutCopyMode = False
    End If
    Sheets("請求書入力").Activate
    Sheets("請求書入力").Range("c2").Select
    Application.ScreenUpdating = True
 End Sub

 ’----------------------------------------------
 ’以下のコードは、請求書入力の「シートモジュール」に貼り付ける。
 ’つまり「標準モジュール」ではないので留意。

 Private Sub Worksheet_Change(ByVal Target As Range)
     Select Case Target.Address(False, False)
         Case "C6":  Range("B10").Select
         Case "B10": Range("B13").Select
     End Select
 End Sub

(半平太) 2020/07/22(水) 20:35


半平様
上記コードを色々テストしまして、
うまく行きました。変更前と比較もしました。
違いもわかりました。
有難うございました。

下記、■2つの意味を教えて頂けますか?

■If msg <> "" Then '未入力あり

        MsgBox Right(msg, Len(msg) - 2)
        Range(adrAry(Val(Left(msg, 1)))).Select
        Exit Sub
    End If
■Private Sub Worksheet_Change(ByVal Target As Range)
     Select Case Target.Address(False, False)
         Case "C6":  Range("B10").Select
         Case "B10": Range("B13").Select
     End Select
 End Sub

(謙児) 2020/07/22(水) 22:48


  税込み金額セルを失念しました m(__)m

  ついでに、未入力セルが他にいくつあるかも、メッセージで出すことにしました。
  また、それら複数のセルも同時にSelectすることにしました。

  ※複数セルの選択なので、アクティブセルは先頭のセルとします。

  修正後
  ↓

 Private Const blankCel As String = "C3,C4,C5,C6,B10,B13,B14"

 Sub セル移動()
     Dim MyRNG As Range
     Dim i As Long
     Dim 確認
     Dim adrAry
     Dim msg As String
     Dim Suffix As String

     Suffix = Chr(13) & "確認して下さい"
     adrAry = Split(blankCel, ",")

     Rem 未入力セルのチェック
     If Range("C3") = "" Then
         msg = "0-担当名が未入力です。" & Suffix
     ElseIf Range("C4") = "" Then
         msg = "1-支払先名が未入力です。" & Suffix
     ElseIf Range("C5") = "" Then
         msg = "2-請求書年月日が未入力です。" & Suffix
     ElseIf Range("C6") = "" Then
         msg = "3-請求書の支払合計が未入力です。" & Suffix
     ElseIf Range("B10") = "" Then
         msg = "4-(1)の勘定科目等が未入力です。他の勘定科目等の漏れはないですか?" & Suffix
     ElseIf Range("B13") = "" Then
         msg = "5-税込み金額が未入力です。" & Suffix
     ElseIf Range("B14") = "" Then
         msg = "6-(1)の支払明細が未入力です。他の支払い明細の、漏れはないですか?" & Suffix
     End If

     If msg <> "" Then '未入力あり
         With Range(blankCel).SpecialCells(xlCellTypeBlanks)
             Range(blankCel).SpecialCells(xlCellTypeBlanks).Select
             Range(adrAry(Val(Left(msg, 1)))).Activate
             MsgBox Right(msg, Len(msg) - 2) & Application.Text(.Cells.Count - 1, Chr(13) & "(その他0件未入力あり);;;")
             Exit Sub
         End With
     End If

     Rem 差額チェック
     Range("D6").Select
     If Range("D6") <> 0 Then
         MsgBox "支払金額と各勘定科目の金額に差額が出ています。" & Suffix
         Exit Sub
     End If

     確認 = MsgBox("請求月は、当月締め日になっていますか?", vbYesNo)
     If 確認 <> vbYes Then
         Exit Sub
     End If

     Application.ScreenUpdating = False

     '▼""じゃなかったらその行を覚える
     With Worksheets("請求書入力").Range("A37:Y42")
         For i = 1 To .Rows.Count
             If .Cells(i, 1).Value <> "" Then
                 If MyRNG Is Nothing Then
                     Set MyRNG = .Rows(i)
                 Else
                     Set MyRNG = Union(MyRNG, .Rows(i))
                 End If
             End If
         Next i
     End With

     '▼覚えたセル範囲があったらコピペする
     If Not MyRNG Is Nothing Then
         MyRNG.Copy
         Sheets("弥生会計へ転記").Range("a1000").End(xlUp).Offset(1). _
         PasteSpecial Paste:=xlPasteValuesAndNumberFormats, _
         Operation:=xlNone, _
         SkipBlanks:=False, _
         Transpose:=False
         Application.CutCopyMode = False
     End If

     '支払別への転記
     '▼""じゃなかったらその行を覚える
     With Worksheets("請求書入力").Range("A37:aa42")
         For i = 1 To .Rows.Count
             If .Cells(i, 1).Value <> "" Then
                 If MyRNG Is Nothing Then
                     Set MyRNG = .Rows(i)
                 Else
                     Set MyRNG = Union(MyRNG, .Rows(i))
                 End If
             End If
         Next i
     End With

     '▼覚えたセル範囲があったらコピペする
     If Not MyRNG Is Nothing Then
         MyRNG.Copy
         Sheets("支払別").Range("a1000").End(xlUp).Offset(1). _
         PasteSpecial Paste:=xlPasteValuesAndNumberFormats, _
         Operation:=xlNone, _
         SkipBlanks:=False, _
         Transpose:=False
         Application.CutCopyMode = False
     End If
     Sheets("請求書入力").Activate
     Sheets("請求書入力").Range("c2").Select
     Application.ScreenUpdating = True
 End Sub

 -----------------------------------------------

 >下記、■2つの意味を教えて頂けますか?
 >■If msg <> "" Then '未入力あり
 >        MsgBox Right(msg, Len(msg) - 2)
 >        Range(adrAry(Val(Left(msg, 1)))).Select
 >        Exit Sub
 >    End If

 修正前のものですが、msgが空白じゃなければ「未入力セルあり」と判定されます。
 その場合、msgの左1文字を切り取ると、adrAryの位置を示すものなので、
 どのセルを選択すべきかが分かると言う寸法です。

 例えば、位置が1なら アドレス文字は「C4」となる。(配列は0番から始まるので)

 adrAry = Array("C3", "C4", "C5", "C6", "B10", "B14")

 >■Private Sub Worksheet_Change(ByVal Target As Range)
 >     Select Case Target.Address(False, False)
 >         Case "C6":  Range("B10").Select
 >         Case "B10": Range("B13").Select
 >     End Select
 > End Sub

 C6セルの値を変えると、B10のセルに飛んで入力準備をする。
 B10セルの値を変えると、B13のセルに飛んで入力準備をする。
 自動的に飛ぶ必要がなければ、このイベントプロシージャは消去してください。

(半平太) 2020/07/22(水) 23:21


ありとあらゆるすべてが人任せなんですね。貴殿の経理人としての矜持的には許容範囲ですか?
(マンモーニ) 2020/07/23(木) 01:03

半平太さま
おはようございます。
上記のコメント、理解で出来ました。
イベントプロシージャを残しておきます。

改めて色々有難うございました。

(謙児) 2020/07/23(木) 07:10


■はじめに
書き溜めているうちに、別の回答者さんとの話がいろいろと進んでいるようなので一段落したあとでお読みください。
特に↓でも書きましたが、すべてのアイデアをごちゃまぜにすると収拾がつかなくなるとおもいます。
[[20180331225641]] 『見積書・納品書・請求書の追加作成』(謙児)

■1
2020/07/16(木) 08:04 に「いいえと押せば一旦止まって入力後に」という表現をされていますが、基本的に一時的に止めて何らかの操作をしたあと"そこから再開する"という処理より、一旦終了して何らかの操作をした後は【初めからチェックしなおす】とかんがえるほうが自然です。

したがって、今回のケースであれば

 (1)C5セルが空白でなければ
       ↓
 (2)当月締め日なのか確認して → Noなら終了
       ↓そうでなければ
 (3)C6セルが空白なら  → 入力するよう警告して終了
       ↓そうでなければ
 (4)B10セルが空白なら  → 入力するよう警告して終了
       ↓そうでなければ
 ・
 ・
 ・
 ・
 (?)(1)以外のすべてが問題なければ処理を実施

というプロセスを考えていたんですよね?
そして、初回以外は(2)のチェックを飛ばしたいという理解をしました。

また、「フォームコントロールで作成しましたボタン"転記"」と仰っているので当初のコードは、おそらく、【標準モジュール】にこのような感じのものがあったのではないでしょうか?

    Option Explicit
    ---------------------------------------------------
    Sub 転記_Click()
        If Sheets("請求書入力").Range("c5") <> "" Then
            If MsgBox("請求月は、当月締め日になっていますか?", vbYesNo) = vbNo Then
                Exit Sub
            End If

            If Sheets("請求書入力").Range("c6") = "" Then
                MsgBox "請求書の支払合計が未入力です" & Chr(13) & "確認して下さい"
                Exit Sub
            End If

            If Sheets("請求書入力").Range("b10") = "" Then
                MsgBox "勘定科目等が未入力です" & Chr(13) & "確認して下さい"
                Exit Sub
            End If
             '
             '
             '
             '登録(転記処理)
        End If
    End Sub

↑を最初の質問部分についてだけ答えるなら、紹介したようにモジュールレベルの変数を使って

    Option Explicit
    Dim ふらぐ As Boolean
    ---------------------------------------------------
    Sub 転記_Click()
        If Sheets("請求書入力").Range("c5") <> "" Then
            If ふらぐ = False Then
                If MsgBox("請求月は、当月締め日になっていますか?", vbYesNo) = vbNo Then
                    Exit Sub
                Else
                    ふらぐ = True
                End If
            End If

            If Sheets("請求書入力").Range("c6") = "" Then
                MsgBox "請求書の支払合計が未入力です" & Chr(13) & "確認して下さい"
                Exit Sub
            End If

            If Sheets("請求書入力").Range("b10") = "" Then
                MsgBox "勘定科目等が未入力です" & Chr(13) & "確認して下さい"
                Exit Sub
            End If
             '
             '
             '
             '登録(転記処理)
        End If
    End Sub

のようにすればOKです。

■3
ただ、未入力箇所があるたびに終了する設計だと、ユーザーからしたらどうせなら1回で全部指摘してくれという気分になるのではないでしょうか?なので↓のように示したわけです。

    もしも、覚えた項目があれば(=空欄項目あり)
       空欄になっている項目を提示してプログラム終了
    そうでなければ
       転記処理を実行して
       次の入力のために各項目をクリア   
    もしもの話はおしまい

↑を前提として [[20200715051835]] の 2020/07/16(木) 17:11 に提示されたコードを整理するとこんな感じでしょうか。

    Option Explicit
    Dim 締め日チェック済 As Boolean
    '-------------------------------------------------------------------------------------
    Sub さんぷる壱_改()
        Dim MySTR As String
        Dim MyRNG As Range
        Dim i As Long

        Stop 'ブレークポイントの代わり

        With Worksheets("請求書入力")
            '▼締め日をチェック----------------------------------------------------------
            If 締め日チェック済 = False Then
                If MsgBox("請求月は、当月締め日になっていますか?", vbYesNo) = vbNo Then
                    MsgBox "当月締め日に修正してください"
                    Exit Sub
                Else
                    締め日チェック済 = True
                End If
            End If
            '▲-----------------------------------------------------------------------------

            '▼入力漏れ等をチェック------------------------------------------------------
            If .Range("C3") = "" Then MySTR = MySTR & "担当名・"
            If .Range("C4") = "" Then MySTR = MySTR & "支払先名・"  '←【セル名】に全角はNG
            If .Range("C5") = "" Then MySTR = MySTR & "請求書年月日・"
            If .Range("C6") = "" Then MySTR = MySTR & "請求書の支払合計・"
            If .Range("B10") = "" Then MySTR = MySTR & "勘定科目等・"
            If .Range("B13") = "" Then MySTR = MySTR & "税込み金額・"
            If .Range("B14") = "" Then MySTR = MySTR & "?@の支払明細・"
            If .Range("B15") = "" Then MySTR = MySTR & "請求書の支払合計・"

            If MySTR <> "" Then
                MySTR = "入力漏れ:" & Left(MySTR, Len(MySTR) - 1)
            End If

            If .Range("d6") <> "o" Then '←文字列をして扱うときは""で囲う
                If MySTR = "" Then
                    MySTR = "支払金額と各勘定科目の金額に差額が出ています"
                Else
                    MySTR = MySTR & vbLf & vbLf & "支払金額と各勘定科目の金額に差額が出ています"
                End If
            End If
            '▲-----------------------------------------------------------------------------

            '▼入力漏れ等があった場合は転記せず警告して終了-------------------------
            If MySTR <> "" Then
                MsgBox MySTR, vbCritical, "★要確認★"
                Exit Sub
            End If
            '▲-----------------------------------------------------------------------------

            '▼↑で終了させていなければ転記すべきセル範囲を取得---------------------
            With .Range("A37:Y42")
                For i = 1 To .Rows.Count
                    If .Cells(i, 1).Value <> "" Then
                        If MyRNG Is Nothing Then
                            Set MyRNG = .Rows(i)
                        Else
                            Set MyRNG = Union(MyRNG, .Rows(i))
                        End If
                    End If
                Next i
            End With
            '▲-----------------------------------------------------------------------------

            '▼取得したセル範囲があるときだけ処理--------------------------------------
            If Not MyRNG Is Nothing Then
                MyRNG.Copy
                Sheets("弥生会計へ転記").Cells(Rows.Count, "A").End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
                Sheets("支払別").Cells(Rows.Count, "A").End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
                Application.CutCopyMode = False
            End If
            '▲-----------------------------------------------------------------------------

            '★必要に応じて入力欄をクリアする★
            .Range("A2").Select
        End With
    End Sub

■4
なお、ユーザーフォームを使う案も提案されていますが、個人的にはシートを入力フォーム扱いにするのは悪い手ではないとおもいます。
入力規則や条件付き書式、そして何より数式が気軽に使えるのが魅力だとおもいます。

■余談
も二な2さんへ
紛らわしいので、できれば別のニックネームにしていただいたほうがありがたいです。
もちろん無理にとは言いませんが・・・

(もこな2 ) 2020/07/23(木) 12:53


もこな2様
私の為に、沢山の時間を取って頂き申し訳ありません。と同時に有難うござ
いました。

>すべてのアイデアをごちゃまぜにすると収拾がつかなくなるとおもいます。
>20180331225641---ここにも記載されていました。

私にとって大事なポイントだと思います。忘れっぽいのですが忘れないように
して行きます。
しかしその当時お世話になったことは、忘れてはいません。

■1
>というプロセスを考えていたんですよね?
>そして、初回以外は(2)のチェックを飛ばしたいという理解をしました。
はい、その通りです。

■3
>↑を前提として [[20200715051835]] の 2020/07/16(木) 17:11 に提示さ
れたコードを整理すると>こんな感じでしょうか。
コードを実行しました。色々考えて頂いた結果、未入力欄が、入力者に
とって一度に見れるような表示。便利なものを作って有難うございました。

(謙児) 2020/07/23(木) 22:49


追加です。
忘れていました。

■余談
も二な2さんへ
紛らわしいので、できれば別のニックネームにしていただいたほうがありが
たいです。
もちろん無理にとは言いませんが・・・

謙児が正しいですが、ケンジの変換を誤って謙治になっていましたのを
気づきませんでした。すみませんでした。

おっしゃるように別のニックネームを考えます。

(謙児) 2020/07/23(木) 23:13


貴方は大きな勘違いをされています。文章の理解力もない人ですか。
もこな2さんが、も二な2さん対して言っていることであって
貴方のニックネームを変えてくださいとは言っていません。
謙児のままでいいですよ。
(もにんち) 2020/07/23(木) 23:40

もにんち様
コメント、有難うございました。

もこな2さんが、も二な2さん対して言っていることであって 文章の理解力もない人ですか。 私も、も二な2さんへ と書いていましたので最初は、えっ と思いました。

私へのコメントの続きで本題とは別なので ■余談として 記載されたと思っ
ていました。
(あくまでも私に対してのコメントと思っていましたから---当該質問で回答
者の方で、も二な2さんがいればすぐに気づきます。)

しかし、もこな2様がいたるところで文章能力があると思っていますので、
その方が自分のニックネームを間違うわけがないと思っていたのですが、
もこな2さんが私のために沢山コードも含め書かれていたので、ひょっとして
入力間違いに気づかないまま記載されたのかと思ってじかに聞くのは、失礼と
おもい、そろっと■余談 も二な2さんへ を入れました。
本来だと■余談も二な2さんへ を入れず
>■余談 紛らわしいので、できれば別のニックネームにしていただいたほう
がありがたいです。
とします。

もこな2様へ
勘違いをしましてすみませんでした。

(謙児) 2020/07/24(金) 03:54


あくまで仮定の話ですが、
もしこの誰でもみれるスレを貴方のライバル企業が見ていて、そのまんま同じマクロを使ったとしたら、貴方の企業のスポンサーはどんな気分になるでしょうか。
(他力本願) 2020/07/24(金) 10:39

 >貴方の企業のスポンサーはどんな気分になるでしょうか。

 他力本願さん

 あなた自身は、どんな気分になると推測するのか、それを聞かせて貰えませんか? 
 そこをクリアにして頂かないと、何が問題なのかさっぱり分かりません。

(半平太) 2020/07/24(金) 11:01


 >会社の事務合理化に繋がるのです。 
 他力本願さんこれについてのコメントですか。
(もにんち) 2020/07/24(金) 11:13

私がスポンサーなら、大丈夫かよ、この会社・・と懐疑的な気分になります。
助手席に先輩がいて、その指導を受けながら走っている後輩の
タクシーに乗っているような不安な気持ちになりますね
(他力本願) 2020/07/24(金) 11:38

 >私がスポンサーなら、大丈夫かよ、この会社・・と懐疑的な気分になります。

 そう言うことでしたか、納得です。

 まぁ、全体の流れからすると、そのリスクは甘受する会社と見てはいますが。

 あと、ここはエクセルのQ&A掲示板であって、経営コンサルじゃないので、
 そこまで突っ込む(心配する)必要も感じないです。(私的にはですが)

(半平太) 2020/07/24(金) 11:53


謙児さん
進捗はどうですか。今の現状教えて下さい。
(他力本願) 2020/07/25(土) 18:38

謙児さん
この件の回答者じゃないから教える必要ありませんよ。
何か企んでるかもよ。

(V) 2020/07/25(土) 18:46


聞くだけなら自由でしょう。そのための掲示板でしょう
(他力本願) 2020/07/25(土) 22:33

コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.