• ベストアンサー

MsgBoxで処理したい

セル"A1"に入力した値が正しければ、セル"B5"に"○"が表示され、 正しくなければ、"×"が表示されるようにしてあります。 そこで、正しくない値が入力された場合のみ MsgBox が表示されて "はい"を選択したらそのまま"A2"に移動し、 "いいえ"を選択したら"A1"をクリアして"A1"に戻るように考えましたがうまくいきません。 下記の記述では全てクリアーされてしまいます。 どの様に記述したらよいでしょうかご教授ねがいます。 If Range("B5").Value = "×" Then MsgBox "処理を継続しますか?", vbYesNo Range("A2").Select Else Range("A1").ClearContents Range("A1").Select End If

質問者が選んだベストアンサー

  • ベストアンサー
  • merlionXX
  • ベストアンサー率48% (1930/4007)
回答No.1

If Range("B5").Value = "×" Then ans = MsgBox("処理を継続しますか?", vbYesNo + vbQuestion, "(*´О`*)?") If ans = vbYes Then Range("A2").Select Else Range("A1").ClearContents Range("A1").Select End If End If

masa2832
質問者

お礼

できました!ありがとうございました。

その他の回答 (3)

  • marbin
  • ベストアンサー率27% (636/2290)
回答No.4

蛇足ですが、参考HPです。 Excel(エクセル)VBA入門:対話型処理1(MsgBox関数) http://www.eurus.dti.ne.jp/~yoneyama/Excel/vba/vba_msgbox.html

  • hallo-2007
  • ベストアンサー率41% (888/2115)
回答No.3

MsgBox ではい を選んだのか いいえ を選んだのかの結果で判断します。 If Range("B5").Value = "×" Then If MsgBox("処理を継続しますか?", vbYesNo) = 6 Then Range("A2").Select Else Range("A1").ClearContents Range("A1").Select End If End If こんな風で試してみてください。

masa2832
質問者

お礼

できました!ありがとうございました。

  • xls88
  • ベストアンサー率56% (669/1189)
回答No.2

↓参考になります。 対話型プロシージャの基礎 http://instructor-diary.hp.infoseek.co.jp/VBA/VBA9.htm

masa2832
質問者

お礼

参考になりました。ありがとうございました。

関連するQ&A

  • Private sub の使い方

    Private Sub Worksheet_Activate() Dim ANS As Integer ANS = MsgBox("Bをクリアしてもいいですか?", _ vbYesNo + vbInformation, "クリア実行") If Sheets("B").Range("D6").Value <> "" Then Select Case ANS Case vbYes Sheets("営業確認").Range("D6:E1000").Select Selection.ClearContents Sheets("入力").Select MsgBox "クリアしました" Case vbNo MsgBox "キャンセル" End Select Else End If End Sub 質問 『A』のシートを開いた時に『B』のシートのD6に値があれば、MsgBoxを出すようにしたく上記のマクロを組みましたが、値が無くてもMsgBoxが表示されてしまいます。 どこがおかしいのかアドバイスをお願いします。

  • IFの使い方

    Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim ANS As Integer ANS = MsgBox("Aをクリアしてもいいですか?", _ vbYesNoCancel + vbInformation, "クリア実行") If Sheets("A").Range("6D").Value <> "" Then Select Case ANS Case vbYes Sheets("営業確認").Range("b6:e1000,g6:k1000").Select Selection.ClearContents Sheets("入力").Select MsgBox "クリアしました" Case vbNo MsgBox "キャンセル" Case Else MsgBox "中止します" End Select Else End If End Sub 説明 (1)『A』というシートのセル『D6』に値が残っていれば メッセージボックスを出す。 (2)メッセージボックスはyes,no,cancelボタンがある (3)YESなら指定したセルの値を消す (4)NOなら消さない (5)キャンセルなら(3)、(4)以外 (6)『A』の『D6』に値がなければメッセージは出ない 上記のようにマクロを組みましたが、IFの所がエラーになってしまいます。

  • マクロ作動

    Private Sub Worksheet_SelectionChange(ByVal Target As Range) tm = Time() '現在時間を取得 If tm < TimeValue("08:30:00") Then Exit Sub If tm > TimeValue("09:30:00") Then Exit Sub  Dim ANS As Integer  Dim 値 As String If Sheets("営業確認").Range("D6").Value <> "" Then ANS = MsgBox(Sheets("営業確認").Range("B6") & "のデーターが残っています。クリアしますか?", _ vbYesNo) Select Case ANS Case vbYes Sheets("営業確認").Select Sheets("営業確認").Range("B6:E461").Select Selection.ClearContents Sheets("営業確認").Range("G6:K461").Select Selection.ClearContents Sheets("入力").Select MsgBox "クリアしました" Case vbNo MsgBox "キャンセル" End Select Else End If End Sub プログラムを組みましたが、上記のとおり時間設定している間は『キャンセル』をしてもセルを動かす度にマクロが動いてしまいます。 下記のようなマクロは可能でしょうか。 (1)一番最初にシートが開くとマクロが作動 (2)その後、指定してるシートに値があってもマクロは作動しない (3)また翌日シートを開くとマクロが作動 ※1日1回マクロが作動出来ればいいです

  • マクロ 追加記述の記述方法を教えて下さい

    いつもお世話になります。 以下のマクロ(参照1)で最後に「勤務表」シートのA1セルに戻って終了させたい場合、 記述の最後に、 Sheets("勤務表").Select Range("A1").Select をそのまま、入れたらシート4からシート34まで、毎回「勤務表」シートのA1セルに戻ってしまいます。 シート3から34まで指示を終えた最後に1回だけ戻るにはどの様な記述にすれば良いのでしょうか? 初歩的な質問で申し訳ありませんが、どなたか解る方、お助けいただけませんでしょうか。 よろしく、お願いいたします。 参照1 If vbYes = MsgBox("作業分担表の作業データを消去してもいいですか?", vbYesNo) Then MsgBox "消去します。" Else MsgBox "中止します。" Exit Sub End If For sheetno = 4 To 34 Worksheets(sheetno).Select ' ' Range("E5:R12,E14:R22,E24:R28,E30:R34,T4:AB16,T24:AB34").Select Selection.ClearContents                    ←ここに挿入   Sheets("勤務表").Select                               Range("A1").Select Next End Sub

  • EXCEL2002 VBAのループ処理について

    セルB1~B24に入力した数字を i とすると、 コマンドボタンを押したときに、セルB1~B24にの全てに値が入力されていて、 セル( F & i )が空白であれば、そこにセルA1の値を入れるようなマクロを作成しています。 セル( F & i )への入力は、セルB1~B24の全部に数値が入力されており、セル( F & i )が空白があるときのみ処理が実行されるように。どちらかが満たされない場合には、メッセージボックスを表示し、処理しないようにしたいのですが、どうしても途中まで入力されてしまいます。 以下のようなコードですが、何か良い方法はないでしょうか? Private Sub CommandButton1_Click() 'ロール確認 Dim 入力 As String, パレット As String Dim i As Long, t As Long For i = 1 To 24 入力 = Range("B" & i) パレット = Range("F" & i) If 入力 = "" Then MsgBox "aaa" Exit For End If 'パレットNo.転記 If パレット <> "" Then MsgBox "bbb" Exit For ElseIf パレット = "" Then Range("F" & 入力).Value = Range("A1").Value End If Next i End Sub

  • エクセルの特定のセルの値が変化したらマクロを自動実行させたい。

    エクセルの特定のセルの値が変化したらマクロを自動実行させたい。 エクセルにてシート1のB5に英数字を入力すると シート2のA列を検索し同じ値があるとその行のB列にある値をH6に表示をします。  【例】   シート1のB5に「A5684」と入力   シート2     A   B   1:A5682 パイン    2:A5683 リンゴ   3:A5684 バナナ   シート1のH6に「バナナ」と表示される シート2のA列にない場合はメッセージボックスで「データがありません」と表示します。 またシート3のA1に数字を入れておき、以下のマクロ、  'Sheet3から印刷すべき連番を獲得します。 Worksheets("Sheet3").Select Range("A1").Select 番号 = ActiveCell 連番 = "A" & Application.WorksheetFunction.Rept("0", 5 - Len(番号)) & 番号  'Sheet3の番号セル「B1」を更新します 番号 = 番号 + 1 ActiveCell.FormulaR1C1 = 番号  'Sheet1のセル「H7」欄に連番を表示します。 Worksheets("シート3").Select Range("B1").Select ActiveCell.FormulaR1C1 = 連番 Worksheets("シート1").Select Range("H6").Select '調べたいセルを記入 If IsError(ActiveCell.Value) Then errval = ActiveCell.Value Select Case errval Case CVErr(xlErrDiv0) MsgBox "#DIV/0! エラー" Case CVErr(xlErrNA) If vbOK = MsgBox(" データがありません") Then Exit Sub End Select End If Sheets("シート1").PrintOut Copies:=1 Range("B5").Select Selection.ClearContents '消去 Range("B5").Select End Sub でシート1のH7に(=シート3!B1)として 印刷ごとに1、2、3、と連番を入れています。 フォームで作成したボタンを押すとH6とH7の値が印刷されます。 そしてB5の値がDeleteされ(よってH6は#N/Aとなる) B5にカーソルが行って入力待ち状態になるようにしてあります。 これで、シート1のB5の値が変化又はH6が変化したら 印刷ボタンを押して印刷ではなく自動印刷されるように出来ますか? Private Sub Worksheet_Change(ByVal Target As Range)  If Target.Column = B And Target.Row = 5 Then を使いましたが 「コンパイルエラー」とか Targetの所が色つきになって「End Sub」が必要です。 となってうまく出来ません。 お願いします。

  • エクセルで繰り返し処理をしたいのですが

    下記のマクロを6行目で展開しています。 これと同じ処理を7行目~36行目めまでさせたいのですが どうやればいいのか教えていただけないでしょうか? sub test() Select Case a Case 2, 3, 4, 5, 6 Range("F6").Select Selection.FormulaR1C1 = _ "=IF(RC[-1]-RC[-2]-0.75-RC[8]-RC[9]<=0,0,RC[-1]-RC[-2]-0.75-RC[8]-RC[9])" Range("H6").Select Selection.FormulaR1C1 = "=IF(-7.75>=RC[9],0,RC[9])" Range("J6").Select Selection.FormulaR1C1 = _ "=IF(IF(RC[-5]<=22,0,(RC[-5]-22-RC[6]))<=0,0,IF(RC[-5]<=22,0,(RC[-5]-22-RC[6])))" Range("B6:W6").Select With Selection.Interior .ColorIndex = 2 .Pattern = xlSolid End With Case 0, 1 Range("F6").Select Selection.ClearContents Range("H6").Select Selection.ClearContents Selection.FormulaR1C1 = "=IF(RC[-5]<=22,0,(RC[-5]-22-RC[6]))" Range("J6").Select Selection.ClearContents Range("B6:W6").Select With Selection.Interior .ColorIndex = 45 .Pattern = xlSolid End With End select End sub

  • EXCEL VBA Array要素記述を変更したい

    プログラムの中にセルの値を直接記入しているところがあます。 Select Caseの行の 「Array("101", "102", "103", "104")」のとろです。 プログラムには101, 102, 103, 104ではなくB10~B13を使用したいのですが、うまくできません。 実際には4つだけではなく何十個もあって作業がわずらわしくなるのと、ブックごとに値が異なって 汎用性がないためです。 アドバイスいただけると助かります。 初歩的なことを質問しているかも入れませんが、よろしくお願いいたします。 シート名「表紙」のA列は部品番号(=シート名)でA10:101 A11:102 A12:103 A13:104とします。 これに対応したシートが4つあり、シート名は、「101」「102」「103」「104」とします。 使用者は「表紙」のシートで下記の作業を行います。 B6セルには製造番号(例:AM01-130012)を入力します。 B10~B13セルは「○」「×」を入力規則から選択します ○を選択した隣のC10~C13セルは部品個数で1~9の数値を入力規則から選択します。 ○を選択したのと同じ行のD10~L10、D11~L11、D12~L12、D13~L13セルに、 文字列を入れる場合と入れない場合があります。文字列は左のD列から順に入れます。 下記マクロにて「○」となっているシートのみコピーを作成します。(1) コピーしたシートすべてのB1セルに製造番号を入力します。(2) D列に文字列があれば、コピーした対応するシートの中のH3~P3セルへ貼り付けます。(3) C列の値によって、コピーした対応するシートの中のH3~P3セルの値をクリアします。(4) <表紙のシート>    A     B     C    D     E     F    G    H     I     J     K      L 5 6    AM01-130012 7 8 9  10 101    ×    9 11 102    ○    3 12 103    ○    8  A1-1  A1-2  A1-3  A1-4  A1-5  A1-6  A1-7  A1-8   13 104    ×    9 <プログラム> Sub TestSample() Dim c As Range Dim 製造番号 As String Dim flg As Boolean flg = True With ThisWorkbook 製造番号 = .Worksheets("表紙").Range("B6").Value For Each c In .Worksheets("表紙").Range("B10:B13") If c.Value Like "○*" Then ' ' (1) If flg Then '  初めてなら、○に対応したシートを「新しいブックにコピー」 .Worksheets(c.Offset(, -1).Text).Copy flg = False Else '  それ以外なら、○に対応したシートをアクティブブックの最後にコピー追加 .Worksheets(c.Offset(, -1).Text).Copy After:=Worksheets(Worksheets.Count) End If ' ' (2) ' ' コピーしたすべてのシート(のB2)に製造番号を書き込む Range("B1").Value = 製造番号 ' ' (3) ' ' ○の行のD:L を 対応するシートのH3:P3 へ貼り付け If c.Offset(, 2) <> "" Then '  D列が空でなければ Range("H3").Value = c.Offset(, 2).Value Range("I3").Value = c.Offset(, 3).Value Range("J3").Value = c.Offset(, 4).Value Range("K3").Value = c.Offset(, 5).Value Range("L3").Value = c.Offset(, 6).Value Range("M3").Value = c.Offset(, 7).Value Range("N3").Value = c.Offset(, 8).Value Range("O3").Value = c.Offset(, 9).Value Range("P3").Value = c.Offset(, 10).Value End If End If Next c End With ' ' (4) For Each 各シート In Worksheets With 各シート .Activate Select Case ThisWorkbook.Worksheets("表紙").Cells(Application.Match(各シート.Name, Array("101", "102", "103", "104"), 0) + 9, "C").Value Case "1" '1のときの仕事をする Range("I3:P3").Select Selection.ClearContents Case "2" '2のときの仕事をする Range("J3:P3").Select Selection.ClearContents Case "3" '3のときの仕事をする Range("K3:P3").Select Selection.ClearContents Range("J3").Select Case "4" '4のときの仕事をする Range("L3:P3").Select Selection.ClearContents Case "5" '5のときの仕事をする Range("M3:P3").Select Selection.ClearContents Case "6" '6のときの仕事をする Range("N3:P3").Select Selection.ClearContents Case "7" '7のときの仕事をする Range("O3:P3").Select Selection.ClearContents Case "8" '8のときの仕事をする Range("P3").Select Selection.ClearContents Case "9" 'do nothing Case Else End Select End With Next If flg Then MsgBox "部品番号が選択されていません。" Exit Sub End If

  • VBA MsgBOXでの処理分岐

    B列に抹消と入力したら別の列に抹消と記載する以下のマクロがありますが、 B列に抹消と入力したらMsgBoxで抹消しますか?と表示させたいです。 MsgBox関数を特定場所に挿入したのですが、うまくいかず、どこに挿入したらよろしいでしょうか。(オブジェクトが必要です。のエラーが出てしまう状況です。) Private Sub Worksheet_Change(ByVal Target As Excel.Range) Dim h As Range On Error Resume Next For Each h In Application.Intersect(Target, Range("B:B")) If h = "抹消" Then Cells(h.Row, "E").Resize(1, 7).SpecialCells(xlCellTypeConstants) = "抹消" End If Next End Sub

  • エクセルVBAでTargetのセルに設定された「名前の定義」の取得方法は?

    例えば、A1、B2、C3セルに「名前の定義」で、それぞれ入力A、入力B、入力C という名前がつけてあります。 それらのセルに入力があった場合、Select Caseで分岐させ作動するマクロをつくりました。 簡略化すると以下のようなもので、一応正しく作動します。 Private Sub Worksheet_Change(ByVal Target As Range) If Intersect(Target, Range("入力A,入力B,入力C")) Is Nothing Then Exit Sub Select Case Target.Address(0, 0) Case "A1" MsgBox "A処理します。" Case "B2" MsgBox "B処理します。" Case "C3" MsgBox "C処理します。" End Select End Sub ただ、せっかくセルに名前を定義してあるのに、個々の入力セルの判定をTarget.Addressでしているのが不満です。 ( ̄~ ̄;) 定義された名前を使えないかと以下のようにやってみましたが実行時エラーで「サポートしてません」となってしまいます。 (T.T) Private Sub Worksheet_Change(ByVal Target As Range) If Intersect(Target, Range("入力A,入力B,入力C")) Is Nothing Then Exit Sub Select Case Target.Names.Name 'ここでエラー Case "入力A" MsgBox "A処理します。" Case "入力B" MsgBox "B処理します。" Case "入力C" MsgBox "C処理します。" End Select End Sub どうやったら、Targetに設定されている名前を取得できるのでしょうか? (^∇^`)? 実際の例はもっと対象が多いので、Select Caseを使わない以下の方法は避けたいのです。 If文の羅列(これでも正しく作動はします。) Private Sub Worksheet_Change(ByVal Target As Range) If Intersect(Target, Range("入力A,入力B,入力C")) Is Nothing Then Exit Sub If Not Intersect(Target, Range("入力A")) Is Nothing Then MsgBox "A処理します。" ElseIf Not Intersect(Target, Range("入力B")) Is Nothing Then MsgBox "B処理します。" Else MsgBox "C処理します。" End If End Sub なにとぞよろしくお願いします。 (o。_。)oペコッ

専門家に質問してみよう