『エラーメッセージの場合分け』（ＥＨＯ）
 	ご無沙汰しております。
         また少しずつ勉強したいのでご指導ください。
         入力シートに、2〜99行目まで仕訳を入れるように入力用の表を作り
         別に、一年分の仕訳をストックする仕訳シートを作りました。
  入力シート										
		Ｃ	Ｄ	Ｅ	Ｆ	Ｇ	Ｈ	Ｉ	Ｊ	Ｋ	Ｌ	Ｍ	
	1	伝票��	日付	部門	摘要	��	借方金額	税	借方科目	借方金額	税	貸方科目	
	2	07001	H19.7.3	Ｏ	6月分 タペストリー 他		48,262 	抜	広告宣伝費				
	3	07001	H19.7.3	Ｏ	消費税		2,413 	外	仮払消費税等				
	4	07001	H19.7.3	Ｏ	6月分 タペストリー 他					50,675 	外	当座	
	・												
	・												
	・												
	100	合計額					50,675 			50,675 			
													
		Ｃ	Ｄ	Ｅ	Ｆ	Ｇ	Ｈ	Ｉ	Ｊ	Ｋ	Ｌ	Ｍ	
	1	伝票��	日付	部門	摘要	��	借方金額	税	借方科目	借方金額	税	貸方科目	
	2	07002	H19.7.4	Ｍ	ゴミ処理料		2,835 	込	雑費	2,835 	外	現金	
	・												
	・												
	・												
	100	合計額					2,835 			2,835 			
													
	仕訳シート												
		Ｂ	Ｃ	Ｄ	Ｅ	Ｆ	Ｇ	Ｈ	Ｉ	Ｊ	Ｋ	Ｌ	Ｍ
	1	伝票��	日付	部門	摘要	��	借方金額	税	借方科目	借方金額	税	貸方科目	入力年月日
	2	07001	H19.7.3	Ｏ	6月分 タペストリー 他		48,262 	抜	広告宣伝費				H19.7.4
	・	07001	H19.7.3	Ｏ	消費税		2,413 	外	仮払消費税等				H19.7.4
	・	07001	H19.7.3	Ｏ	6月分 タペストリー 他					50,675 	外	当座	H19.7.4
													
													
													
	上のように、貸借を同じ行に入力する場合とそうでない場合があります。												
	Ｃ列は表示形式 00000 五桁の数値にしています。												
	Ｄ列は表示形式 日付 にしています。												
													
	●正しい入力方法												
	Ｃ	伝票��	左端２桁の数値とＤ列月の数値が必ず一致										
	Ｄ	日付	左端２桁の数値とＤ列月の数値が必ず一致										
			例えば、										
				7月データなのに70002になってると間違い									
				7月→07・・・ 8月→08・・・ 12月→12・・・									
	Ｅ	部門	Ｄ〜Ｍ列のどこかにデータがあれば必ず入力										
	Ｆ	摘要	Ｄ〜Ｍ列のどこかにデータがあれば必ず入力										
	Ｇ	��	あってもなくてもＯＫ										
	Ｈ	借方金額	Ｈ100＝Ｋ100になるように入力										
	Ｉ	税	Ｈ列に数値があれば必ず入力										
	Ｊ	借方科目	Ｈ列に数値があれば必ず入力										
	Ｋ	借方金額	Ｈ100＝Ｋ100になるように入力										
	Ｌ	税	Ｋ列に数値があれば必ず入力										
	Ｍ	貸方科目	Ｋ列に数値があれば必ず入力										
													
	このように入力して、ＯＫなら仕訳シートに転記して												
	入力シートの表の中身はクリアする、というマクロを作りたいと思いました。												
													
	正しい入力方法に合っていない場合は、												
	間違った仕訳を仕訳シートに登録するのを防ぐために												
	エラーメッセージを表示して、登録をしないようにしたいので												
	下のようなコードを以前教えてもらい、入れてみました。												
	しかし、このコードだと、どの列がおかしくても												
	すべてのエラーメッセージがでてきます。												
	例えば、摘要が空欄の場合でも												
	「部門が入っていません」から全部でてきます。												
	的確にエラーメッセージを出したいのですが												
	どうしたらよいか、教えていただけないでしょうか？												
													
	Option Explicit												
	Sub 仕訳登録()												
	Dim MyA As Variant												
	Dim i As Long												
	Dim x As Long												
	Dim myrow												
	Dim myflg												
	With Sheets("入力")												
	myrow = .Range("K65536").End(xlUp).Row												
	    If Left(.Cells(2, 3), 2) <> CStr(Month(.Cells(2, 4))) Then												
	            MsgBox "�ｂｩ日付が間違っています"												
	    End If												
	    If (IsNumeric(.Cells(myrow, 8)) Or IsNumeric(.Cells(myrow, 11))) And .Cells(myrow, 5).Value = "" Then												
	            MsgBox "部門が入っていません"												
	    End If												
	    If (IsNumeric(.Cells(myrow, 8)) Or IsNumeric(.Cells(myrow, 11))) And IsEmpty(.Cells(myrow, 6)) Then												
	            MsgBox "摘要が入っていません"												
	    End If												
	    If IsNumeric(.Cells(myrow, 8)) And IsEmpty(.Cells(myrow, 9)) Then												
	            MsgBox "借方の税欄が入っていません"												
	    End If												
	    If IsNumeric(.Cells(myrow, 8)) And IsEmpty(.Cells(myrow, 10)) Then												
	            MsgBox "借方の科目が入っていません"												
	    End If												
	    If IsNumeric(.Cells(myrow, 11)) And IsEmpty(.Cells(myrow, 12)) Then												
	            MsgBox "貸方の税欄が入っていません"												
	    End If												
	    If IsNumeric(.Cells(myrow, 11)) And IsEmpty(.Cells(myrow, 13)) Then												
	            MsgBox "貸方の科目が入っていません"												
	    End If												
	    If .Cells(100, 8) <> .Cells(100, 11) Then												
	            MsgBox "貸借金額が合っていません"												
	    End If												
	        Exit Sub												
	End With												
	With Sheets("入力")												
	    MyA = .Range("C2:M99").Value												
	End With												
	With Application												
	    .ScreenUpdating = False												
	        For i = 1 To UBound(MyA, 1)												
	            '入力シートのF列にデータがある行をコピー、												
	            If MyA(i, 4) <> "" Then												
	                Sheets("仕訳").Range("B65536").End(xlUp).Offset(1). _												
	                    Resize(, UBound(MyA, 2)).Value = .Index(MyA, i, 0)												
	            '入力日付												
	              Sheets("仕訳").Cells(Sheets("仕訳").Range("B65536").End(xlUp).Row, 13).Value = Date												
	            End If												
	        Next												
	    .ScreenUpdating = True												
	End With												
	'3.入力シートC2からD2,E2からM99をクリア												
	'4.入力シートC2を選択												
	With Sheets("入力")												
	    .Range("C2:D2,E2:M99").ClearContents												
	    Application.Goto .Range("C2")												
	End With												
	Erase MyA												
	 End Sub												

----
 お久しぶりです。みやほりんです。
	With Sheets("入力")
	myrow = .Range("K65536").End(xlUp).Row
	    If Left(.Cells(2, 3), 2) <> CStr(Month(.Cells(2, 4))) Then
	            MsgBox "�ｂｩ日付が間違っています"	
	    End If
	    If (IsNumeric(.Cells(myrow, 8)) Or IsNumeric(.Cells(myrow, 11))) And .Cells(myrow, 5).Value = "" Then
	            MsgBox "部門が入っていません"
	    End If
	    If (IsNumeric(.Cells(myrow, 8)) Or IsNumeric(.Cells(myrow, 11))) And IsEmpty(.Cells(myrow, 6)) Then
	            MsgBox "摘要が入っていません"
	    End If
	    If IsNumeric(.Cells(myrow, 8)) And IsEmpty(.Cells(myrow, 9)) Then
	            MsgBox "借方の税欄が入っていません"
	    End If
	    If IsNumeric(.Cells(myrow, 8)) And IsEmpty(.Cells(myrow, 10)) Then
	            MsgBox "借方の科目が入っていません"
	    End If
	    If IsNumeric(.Cells(myrow, 11)) And IsEmpty(.Cells(myrow, 12)) Then
	            MsgBox "貸方の税欄が入っていません"
	    End If
	    If IsNumeric(.Cells(myrow, 11)) And IsEmpty(.Cells(myrow, 13)) Then
	            MsgBox "貸方の科目が入っていません"
	    End If
	    If .Cells(100, 8) <> .Cells(100, 11) Then	
	            MsgBox "貸借金額が合っていません"	
	    End If
	        Exit Sub
	End With	
この部分でしょうけれども、End With	の前にExit Subしているので、その後のコードは
メッセージ表示がなくても実行されません。この部分は再考の必要あり。
　
制御としては8っつのIFステートメントが連続し、処理を抜けるところがないのですべての
IFステートメントが実行されてしまう形です。
次の構文を応用してみてください。
 Sub test()
     Select Case True
          Case Range("A1") = 3
              MsgBox "A1が３"
          Case Range("B1") = 3
              MsgBox "B1が３"
          Case Range("C1") = 3
              MsgBox "C1が３"
          Case Range("D1") = 3
              MsgBox "D1が３"
     End Select
 End Sub
　
CaseがTrueになる部分だけ処理されます。
(みやほりん)(-_∂)b
----
 本当にお久しぶりです!!
 ごちゃごちゃした質問に返答ありがとうございます！
 なんとかやってみます！
 (EHO)
----
 ちょっとだけサンプル。
 Sub test()
     Dim AryMsg As Variant, MyMsgNum As Long
     Const MyTxt As String = "�ｂｩ日付が間違っています " & _
                             "部門が入っていません " & _
                             "摘要が入っていません " & _
                             "借方の税欄が入っていません " & _
                             "借方の科目が入っていません " & _
                             "貸方の税欄が入っていません " & _
                             "貸方の科目が入っていません " & _
                             "貸借金額が合っていません"
     AryMsg = Split(MyTxt)
     MyMsgNum = 0
     Select Case True
         Case Range("A1") = 1
             MyMsgNum = 0
         Case Range("A1") = 2
             MyMsgNum = 1
         Case Range("A1") = 3
             MyMsgNum = 2
         Case Range("A1") = 4
             MyMsgNum = 3
         Case Range("A1") = 5
             MyMsgNum = 4
         Case Range("A1") = 6
             MyMsgNum = 5
         Case Range("A1") = 7
             MyMsgNum = 6
         Case Range("A1") = 8
             MyMsgNum = 7
         Case Range("A1") > 8
             MyMsgNum = 8
     End Select
     If MyMsgNum >= 8 Then
         MsgBox "予想外"
     ElseIf MyMsgNum > 0 Then
         MsgBox AryMsg(MyMsgNum)
         Exit Sub
     Else
         Rem 処理
     End If
 End Sub
　
SelectCaseでセルA1の値により表示メッセージの番号を設定。
メッセージ番号により処理の分岐を行う構造です。
　
Case Range("A1") = 1の部分は実際の条件式に差し替え。
Rem 処理　の部分がWith Sheets("入力")以下の実行コード部分に差し替え。
上手く組み合わせてみてください。
(みやほりん)(-_∂)b

----
 ありがとうございます。
 2度目に回答してくださった分でやってみました。
 条件式がおかしいのか、摘要を未記入にしても、貸借金額を違えても、
 部門が入っていません
 と出ます。
 全て正しく入力しても 部門が入っていません。
 と出て登録できません。
 日付を違えて入力してその他を正しく入力すると
 登録されてしまいました。
 ずっと考えているんですが分からないので教えていただけませんか・・・。
 今のコードを下に示します。
 
 Sub test()
     Dim AryMsg As Variant, MyMsgNum As Long
     Dim myrow
     Dim MyA As Variant
     Dim i As Long
     Dim x As Long
     Dim myflg
     
        myrow = Range("K65536").End(xlUp).Row
     Const MyTxt As String = "�ｂｩ日付が間違っています " & _
                             "部門が入っていません " & _
                             "摘要が入っていません " & _
                             "借方の税欄が入っていません " & _
                             "借方の科目が入っていません " & _
                             "貸方の税欄が入っていません " & _
                             "貸方の科目が入っていません " & _
                             "貸借金額が合っていません"
     AryMsg = Split(MyTxt)
     MyMsgNum = 0
     With Sheets("入力")
     Select Case True
         Case Left(.Cells(2, 3), 2) <> CStr(Month(.Cells(2, 4)))
             MyMsgNum = 0
         Case (IsNumeric(.Cells(myrow, 8)) Or IsNumeric(.Cells(myrow, 11))) And .Cells(myrow, 5).Value = ""
             MyMsgNum = 1
         Case (IsNumeric(.Cells(myrow, 8)) Or IsNumeric(.Cells(myrow, 11))) And IsEmpty(.Cells(myrow, 6))
             MyMsgNum = 2
         Case IsNumeric(.Cells(myrow, 8)) And IsEmpty(.Cells(myrow, 9))
             MyMsgNum = 3
         Case IsNumeric(.Cells(myrow, 8)) And IsEmpty(.Cells(myrow, 10))
             MyMsgNum = 4
         Case IsNumeric(.Cells(myrow, 11)) And IsEmpty(.Cells(myrow, 12))
             MyMsgNum = 5
         Case IsNumeric(.Cells(myrow, 11)) And IsEmpty(.Cells(myrow, 13))
             MyMsgNum = 6
         Case .Cells(100, 8) <> .Cells(100, 11)
             MyMsgNum = 7
         Case Range("A1") > 8
             MyMsgNum = 8
     End Select
      If MyMsgNum >= 8 Then
         MsgBox "予想外"
     ElseIf MyMsgNum > 0 Then
         MsgBox AryMsg(MyMsgNum)
         Exit Sub
     
     Else
      With Sheets("入力")
          MyA = .Range("C2:M99").Value
      End With
      With Application
          .ScreenUpdating = False
           For i = 1 To UBound(MyA, 1)
            '入力シートのF列にデータがある行をコピー、
            If MyA(i, 4) <> "" Then
                Sheets("仕訳").Range("B65536").End(xlUp).Offset(1). _
                    Resize(, UBound(MyA, 2)).Value = .Index(MyA, i, 0)
            '入力日付
              Sheets("仕訳").Cells(Sheets("仕訳").Range("B65536").End(xlUp).Row, 13).Value = Date
            End If
        Next
          .ScreenUpdating = True
      End With
 '3.入力シートC2からD2,E2からM99をクリア
 '4.入力シートC2を選択
     With Sheets("入力")
         .Range("C2:D2,E2:M99").ClearContents
         Application.Goto .Range("C2")
     End With
     Erase MyA
     End If
     End With
  End Sub
----
 ということは条件式の問題ではないでしょうか。
(IsNumeric(.Cells(myrow, 8)) Or IsNumeric(.Cells(myrow, 11))) And .Cells(myrow, 5).Value = ""
　
「.Cells(myrow, 5) が ""」かつ「.Cells(myrow, 8)　もしくは.Cells(myrow, 11)[の値]が数値」
である時に "部門が入っていません " が表示されるべきですが、この論理でOKですか？
つまり、このメッセージが表示されないためには
「.Cells(myrow, 5) に何か入力されている」もしくは
「.Cells(myrow, 8)　と.Cells(myrow, 11)の両方が数値に出来ない」状況が必要です。
　
(みやほりん)(-_∂)b
----
 はい。
 貸借金額のどちらかに数値が入っているとき
 部門、摘要は要記入なので、それでいいはずなんですが・・・。
 ひょっとしてmyrowがおかしいんでしょうか
 （EHO）
----
 IsNumeric(.Cells(myrow, 8)) および、IsNumeric(.Cells(myrow, 11))は
セルが未入力の状況でもTrueになりますので「貸借金額のどちらかに数値が入っているとき」
の判定にはIsnumericは不適切です。数値入力の制限などはシートの機能の入力規則を活用し、
入力判定そのものはIsnumericの部分に関してはLen関数などで文字列長チェックしては
いかがでしょうか。
それにしても、部門は必ず入力されるべき項目ですから And .Cells(myrow, 5).Value = ""
がTrueになるのは今一つ合点がいきません。E列でmyrowの行のセルが未入力または文字長0の
文字列であると結論せざるを得ません。
実は、myrowがK列（借方金額）なのも気がかり。
「貸借金額のどちらかに数値が入る＝どちらかに入っていない場合もありうる」ですから、
myrowが意図する行を取得していないかもしれません。
　
「100	合計額	」とあり、また、例示の表ではK列に借り方合計金額があるように見え
ますから、myrowが常に100行目を取得している可能性を指摘します。
だとすれば部門は必ず入力されるべき項目であるはずなのに未入力判定が下される理由が
納得いきます。
　　
(みやほりん)(-_∂)b

----
 おっしゃる通りです。。。
 条件式を一から考え直さないといけないようです。
 同じ行の、Ｈ列とＫ列の合計額が０より大きい場合に
 部門Ｅ列 に記入されていないと、メッセージを表示、
 同じく摘要Ｆ列に記入されていないと、メッセージを表示、
 という風に変えようと思いましたが、
 それをコードで表現できません(；；)
 教えていただけないでしょうか。
 
 それと、日付の月と伝票ナンバーの左２桁のチェックの条件式もおかしいと思い、
  Case (Month(.Cells(2, 4)) * 1000 > .Cells(2, 3)) _
                  Or (.Cells(2, 3) > (Month(.Cells(2, 4)) * 1000 + 999))
                  MyMsgNum = 0
 と変えたのですが、誤記入があっても素通りして登録実行してしまいます。
 行き詰ってしまいました・・・。
 お願いいたします。
 (EHO)
 
----
 まずは根本となるmyrowの取得。
C列からM列まで、99行までの最大行数を把握する必要があります。
精度を高くするには最終行を厳密にチェックした方がいいでしょう。
私も最終行の取得はEndプロパティだけでは不満足なので関数を作ってみました。
関数CheckInputLastRowはコメントの通り。
test20070705aを実行するとC1:M99の最終行とみなされる行番号を表示します。
　
 Sub test20070705a()
 Dim myRng As Range
 Set myRng = Range("C1:M99")
 MsgBox myRng.Address(0, 0) & "の範囲で入力済みの最終行は" & CheckInputLastRow(myRng) & "行目です。"
 End Sub
　
　
 Private Function CheckInputLastRow(ByVal myRng As Range) As Long
     Rem セル範囲の中の入力済み最終行を数値で返す関数。
     Rem ただし長さのない文字列がセルに返っていた場合は未入力とみなします。
     Dim MyR As Long, MyC As Long, myrow As Long
     Dim lngR1 As Long, lngR2 As Long
     Dim lngC1 As Long, lngC2 As Long
     Dim strChk As String
     With myRng
         lngR1 = .Cells(1).Row
         lngR2 = .Cells(.Cells.Count).Row
         lngC1 = .Cells(1).Column
         lngC2 = .Cells(.Cells.Count).Column
     End With
     For MyR = lngR2 To lngR1 Step -1
         For MyC = lngC1 To lngC2
             strChk = strChk & Cells(MyR, MyC).Value
         Next MyC
         If Len(strChk) > 0 Then
             myrow = MyR
             Exit For
         End If
     Next MyR
     CheckInputLastRow = myrow
 End Function
　
EHOさんのコードではmyrow = Range("K65536").End(xlUp).Row　の替わりに
myrow = CheckInputLastRow(Range("C1:M99"))
として使用します。
　
＞ 同じ行の、Ｈ列とＫ列の合計額が０より大きい場合に
＞ 部門Ｅ列 に記入されていないと、メッセージを表示、
　
((Val(.Cells(myrow, 8).Value) + Val(.Cells(myrow, 11).value)) > 0) And Len(.Cells(myrow, 5).Value) = 0
　
F列も同様。
　
＞誤記入があっても素通りして登録実行してしまいます。
伝票�ｂﾌ列の書式設定の表示形式は文字列ですか？
         Case Not IsNumeric(.Cells(2, 3))
             mymsgnum = 0
         Case (Month(.Cells(2, 4)) * 1000 > CLng(.Cells(2, 3))) Or _
              (CLng(.Cells(2, 3)) > (Month(.Cells(2, 4)) * 1000 + 999))
             mymsgnum = 0
「誤記入」として「数値に出来ない文字列」が入るとその次の判定だけではコケマス。
先に「数値に出来る文字列かどうか」を別に判定しておいた方が無難。
(みやほりん)(-_∂)b
----
 お返事遅くなってます(。。)
 一日かかって、あーでもないこーでもないとイジクリまわして
 まだできずにいます(*・・*)
 また明日がんばります！
 せっかく教えていただいたのにトロくてすみません。。。
 （EHO）