- 締切済み
ＩＦ文の分岐が機能していない？
初めて投稿させて頂きます。宜しくお願いします。 殆どＶＢＡ初心者です。 特定のセルに入力すると、シート名を固定のセル（Ｓ１２）の文字列に変更するコードを書きました。 （Ｓ１２は他のセルからの参照値を結合したものです。 Ｂ２”受注”＋Ｐ２”５月”＝Ｓ１２”受注５月”がシート名に入ります） ネット検索で参照エラーやシート名の重複エラーを調べて自力で組みましたが、どこかがおかしいようでちゃんと機能していません。 (1)新しいシート名ならばエラーは出ず、シート名の変更が出来る (2)Ｓ１２がエラー値であれば、シート名は変更されない これは狙い通りなのですが、 (3)重複シート名の場合、（２）を付けて変更する（これはエラーでマクロが止まります） (4)同じシートを何度か名前変更した時に、下のタグに無い名前も重複シートとして認識される この、(3)と(4)でマクロが止まり困っています。 (3)は重複でなければどのような処理でも問題ありません。(4)は(3)がクリア出来れば、あまり弊害はありませんがクリアできたら幸いです。 下記コードのどこが間違っているのか、教えて頂けませんでしょうか？ Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) Dim flag As Boolean, s As Variant If Intersect(Target, Range("B2:P2")) Is Nothing Then Exit Sub Else For Each s In Sheets If IsError(ActiveSheet.Range("S12").Value) Then Exit Sub Else If s.Name = ActiveSheet.Range("S12").Value Then Sh.Name = ActiveSheet.Range("S12").Value ＋"(2)" Exit Sub Else Sh.Name = ActiveSheet.Range("S12").Value Exit Sub End If End If Next s End If End Sub
- kinnoji69
- お礼率100% (1/1)
- SE・インフラ・Webエンジニア
- 回答数1
- ありがとう数1
- みんなの回答 （1）
- 専門家の回答
みんなの回答
- bin-chan
- ベストアンサー率33% (1403/4213)
最初のIF文 > If Intersect(Target, Range("B2:P2")) Is Nothing Then でF9キー押下してブレークポイント作成し、F8押下でステップ実行。 気になる変数にマウスカーソル当てれば、値をみることができるし、 いざとなったらイミディエイトで値設定（変更）も可能です。
関連するQ&A
- 印刷後のVBAの実行 (3)
Private Sub Workbook_BeforePrint(Cancel As Boolean) If ActiveSheet.Name = "Sheet1" Then If Range("D6").Value = "" Then Cancel = True MsgBox ("名前を入力してください") Range("D6").Select Exit Sub End If Else If ActiveSheet.Name = "Sheet2" Then If Range("C11").Value = "" Then Cancel = True MsgBox ("受付時間を入力してください") Range("C11").Select Exit Sub End If Else Exit Sub End If End If If Worksheets("Sheet1").Range("D5") = "不要" Then GoTo P1 ActiveSheet.Range("A70:Y70").Copy If Worksheets("Sheet3").Range("A1").Value = "" Then Worksheets("Sheet3").Range("A1").PasteSpecial Paste:=xlPasteValues Else Worksheets("Sheet3").Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial _ Paste:=xlPasteValues End If Application.CutCopyMode = False P1: ActiveSheet.Range("A1").Select End Sub sheet1のD5に「不要」と入っていたら 24～33行目の作業がキャンセルになりますが sheet2のD5にも「不要」と入っていたら、同じ様にキャンセルできる様に出来ますでしょうか？ ご回答お願いします
- 締切済み
- オフィス系ソフト
- 印刷後のVBAの実行 (2)
Private Sub Workbook_BeforePrint(Cancel As Boolean) If ActiveSheet.Name = "Sheet1" Then If Range("D6").Value = "" Then Cancel = True MsgBox ("名前を入力してください") Range("D6").Select Exit Sub End If Else If ActiveSheet.Name = "Sheet2" Then If Range("C11").Value = "" Then Cancel = True MsgBox ("受付時間を入力してください") Range("C11").Select Exit Sub End If Else Exit Sub End If End If ActiveSheet.Range("A70:Y70").Copy If Worksheets("Sheet3").Range("A1").Value = "" Then Worksheets("Sheet3").Range("A1").PasteSpecial Paste:=xlPasteValues Else Worksheets("Sheet3").Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial _ Paste:=xlPasteValues End If Application.CutCopyMode = False ActiveSheet.Range("A1").Select End Sub 先日、上記のコードを回答者の方から教えてもらい、とても助かっていますが sheet1のD5に「不要」という文字が入っていた場合、 sheet3への貼り付け(23～30行目の作業)をキャンセルして、最後にsheet1のA1を選択するようにはどの様にしたらいいでしょうか?
- 締切済み
- オフィス系ソフト
- マクロで分岐をさせる方法
下記の記録マクロでWith→End With 間にIFで分岐を試みたのですが エラーになります。どうすれば出来るのか伝授をお願いします。 マクロは初心者です。 Dim hensuh(2) As Integer Dim dekiru As Long Dim kinek As Long Dim uineu As Long Dim myTime As Date Dim flg As Boolean Sub OnTimeSamp1() Application.OnTime EarliestTime:=TimeValue("09:00:00"), Procedure:="Ontime_Set" '記録開始 Application.OnTime EarliestTime:=TimeValue("11:00:00"), Procedure:="Ontime_Reset" '記録終了 End Sub Sub Ontime_Set() 'トグルになっている If flg = False Then flg = True myTime = Now + TimeSerial(0, 0, 1) ElseIf flg = True Then flg = False Else Exit Sub End If If Range("A1").Value = "" Then Range("A1").Value = Format(Now, "hh:mm:ss") '時間記録（スタート) End If Application.OnTime EarliestTime:=myTime, _ Procedure:="my_Procedure", Schedule:=flg If flg = False Then myTime = 0 End If End Sub Sub my_Procedure() Worksheets("kirokuyou").Activate 'ワークシートをアクティブにする。（記録中別のワークシートを開けた場合そこに記録されてしまうのを防ぐ） With Range("A65536").End(xlUp).Offset(1) .Value = Format(Now, "yyyy:mm:dd:hh:mm:ss") '時間記録 .Offset(, 1).Value = Range("S3").Value 'S3 の値 .Offset(, 2).Value = Range("T3").Value 'T3 の値 .Offset(, 3).Value = Range("U3").Value 'U3 の値 .Offset(, 4).Value = Range("V3").Value 'V3 の値 dekiru = Range("V3").Value Range("V6").Value = dekiru kinek = Range("T22").Value Range("T18").Value = kinek uineu = Range("U22").Value Range("U18").Value = uineu 'IF S17 >= 120 Then 'hensuh(0) = Range("S17").Value ←変数に代入後、分岐させたいのですがエラーになる 'Elseif S17 >= 110 Then 'hensuh(1) = Range("S17").Value ←変数に代入後、分岐させたいのですがエラーになる 'Elseif S17 >= 100 Then 'hensuh(2) = Range("S17").Value ←変数に代入後、分岐させたいのですがエラーになる 'End If flg = False myTime = 0 End With Call Ontime_Set End Sub Sub Ontime_Reset() 'タイマーリセット On Error Resume Next Application.OnTime EarliestTime:=myTime, _ Procedure:="my_Procedure", Schedule:=False If Err.Number > 0 Then MsgBox "OnTime設定はされていません。", 64 Err.Clear flg = False Else MsgBox myTime & "の設定は解除されました。", 64 flg = False myTime = Empty End If End Sub
- ベストアンサー
- オフィス系ソフト
- セルの値をワークシート名にする(エクセル2013)
インストラクターのネタ帳さんより http://www.relief.jp/itnote/archives/003382.php 下記「セルの値をワークシート名にする?Worksheet_Change」 を拝借し利用させていただこうと思いましたが ---------------------- Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) On Error GoTo ERR_HANDLER If Target.Address(False, False) = "H1" Then ActiveSheet.Name = Range("H1").Value End If Exit Sub ERR_HANDLER: MsgBox "現在のH1セルの値はシート名にできません。" End Sub ---------------------- はそのまま出来るのですが、 H1セルにデータの入力規則：リストを指定しますと エラーとなりシート名が変わりません sheet1のリストA1:A50をsheet2のH1セルにリスト表示させ その表示名をそのままシート名に出来ませんでしょうか？ ---------------------- Sub copy Range("H1").Copy Range("P1") End Sub ---------------------- Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) On Error GoTo ERR_HANDLER If Target.Address(False, False) = "P1" Then ActiveSheet.Name = Range("P1").Value End If Exit Sub ERR_HANDLER: MsgBox "現在のP41セルの値はシート名にできません。" End Sub ---------------------- としてH1のセルをP1にコピーしたものを指定して試しましたがやはりエラーとなり うまくいきませんでした。 全くの素人で恐縮ですがよろしくお願いいたします
- ベストアンサー
- Excel（エクセル）
- 印刷後のVBAの実行(4)
Private Sub Workbook_BeforePrint(Cancel As Boolean) If ActiveSheet.Name = "顧客データー1" Then If Range("D1").Value = "" Then Cancel = True MsgBox ("名前を入力してください") Range("D1").Select Exit Sub End If Else Exit Sub End If End If If Worksheets("顧客データー1").Range("D6") = "不可" Or _ Worksheets("顧客データー2").Range("D6") = "不可" Then GoTo P1 ActiveSheet.Range("F650:O650").Copy If Worksheets("日報").Range("F5").Value = "" Then Worksheets("日報").Range("F5").PasteSpecial Paste:=xlPasteValues Else Worksheets("日報").Range("F65536").End(xlUp).Offset(1, 0).PasteSpecial _ Paste:=xlPasteValues End If Application.CutCopyMode = False P1: ActiveSheet.Range("A1").Select End Sub 現在上記コードを使っていますが、ワークシート日報への値のみ貼り付けの部分で少し変更したいのですが、印刷するシートのセルM1の値が1ならそのシートのRangeF650:O650をコピーしてワークシート日報のF5に値のみで貼り付け、M1の値が2ならF6に、M1の値が3ならF7に・・・という感じでM1の数字の値によってワークシート日報へ貼り付け先を変えていくようしたいのですが、どのようにコードを変更したらいいでしょうか?
- ベストアンサー
- オフィス系ソフト
- End Ifは不要な場合もある？
Excel2010使用で下記のVBAのコードを書きました。 Sub イフとエンドイフは組ではなかったのか() Dim Flag As Boolean Dim S As Worksheet For Each S In Worksheets If S.Name = "合計" Then Flag = True ' Else ' Flag = False ' End If Next S If Flag = True Then MsgBox "「合計」というシートはすでに存在します" Else Worksheets(1).Copy after:=Worksheets(Worksheets.Count) ActiveSheet.Name = "合計" End If End Sub 前半の >' Else >' Flag = False >' End If の部分があると「Elseに対応するIfがありません」というエラーが出ます。 Elseに関する記述だけをコメントアウトすると「End Ifに対応するIfブロックがありません」というエラーが出ます。 この部分をコメントアウトすればきちんと動作するのですが、If文はちゃんと存在しているにもかかわらず、またほとんど同じ記述の後半ではエラーが出ないというのに、なぜこのようなエラーが出るのかわかりません。 なにか勘違いをしているのでしょうか。
- ベストアンサー
- Excel（エクセル）
- Excel2010 イベントプロシージャが動かない
VBAはほとんどいじったことのない初心者です。 イベントプロシージャをインターネットから探してきて、コピペして使おうとしてます。 Private Sub Worksheet_Change(ByVal Target As Range) On Error GoTo ERR_HANDLER If Target.Address(False, False) = "E2" Then ActiveSheet.Name = Range("E2").Value End If Exit Sub ERR_HANDLER: MsgBox "現在のE2セルの値はシート名にできません。" End Sub やりたいのは、セルE2の値に変更があったら、そのセルの値をシート名にしたいということです。 初心者には難しいでしょうか？ ご教示いただけると幸いです。 よろしくお願いします。
- ベストアンサー
- オフィス系ソフト
- シートを増やすVBA
フィルタで隠れている場合もある列の値を シート名として増やしていくVBAで以下のようなものをつくりました （値は重複している場合もある） 雛型シートがありそれをシート名だけ増やしていくというものです Sub シートを増やす() Dim target As Range Dim h As Range On Error Resume Next Set target = Worksheets("一覧シート").Range("E10:E" & Worksheets("一覧シート").Range("E65536").End(xlUp).Row).SpecialCells(xlCellTypeVisible) If target Is Nothing Then Exit Sub 'シートを増やしていく For Each h In target On Error GoTo errhandle Worksheets(h.Value).Select On Error GoTo 0 Next Sheets("一覧シート").Select Exit Sub errhandle: Worksheets("雛型").Copy after:=Worksheets(Worksheets.Count) ActiveSheet.Name = h.Value Resume End Sub そうすると、実行エラー1004 ”シートの名前をほかのシート、Visual Basicで参照されるオブジェクトライブラリまたはワークシートと同じ名前に変更することはできません。” というエラーがたまにおきます（シート名が数字の場合におきるようです） 解決方法及び理由をご教授ください
- ベストアンサー
- オフィス系ソフト
- IF文の作り方
エクセル VBA 超入門のものなんですけど、質問させてください。 A1のセルに １を入力したら、セルD１に正解を表示させ、 それ以外なら不正解を表示させたいのですが、 以下の文でつくると 実行した最初しか起動してないような気がするのですが、教えてください。どうすればセルA1を入力するたびに、 正解、不正解をD１に表示させれるでしょうか？ Sub テスト() If Range("A1") = "1" Then Range("D1").Value = "正解" Else Range("D1").Value = "不正解" End If End Sub
- ベストアンサー
- Visual Basic
- if文について
Excel 2007 VBAを使用しています。 ↓のクリックイベントを実行するとif文のところで不具合があります。 商品シートのC列には、状況が保存されています。 該当した年月、"受取済み"、"注文中"以外の行データをリストさせます。 商品シートのJ列、W列には、該当した年月、"受取済み"、"注文中"以外の行データが存在するのですが、まったく検出してくれません。 対処方法を教えてくれませんか? ------------------------------------------- Option Explicit Private Sub CB1_Click() '変数を定義 Dim i As Long Dim maxRow As Long Dim inSheet As Worksheet Dim outSheet As Worksheet '入出力先のシートをオブジェクト変数へ格納 Set inSheet = Worksheets("商品") Set outSheet = Worksheets("結果") 'テキストボックスの内容を判定 If (Me.TextBox21.Value = "") Or (Not IsDate(Me.TextBox21.Value)) Then MsgBox "日付が入力されていません" Exit Sub End If '最終行番号を取得 maxRow = Me.Cells(Rows.Count, "A").End(xlUp).Row '商品シートの最終行番号で分岐処理 If maxRow > 3 Then '出力先を削除してヘッダーをコピー outSheet.Cells.Delete inSheet.Range("A3").EntireRow.Copy outSheet.Range("A1") Application.CutCopyMode = False Else '4行目以降にデータが入力されていなければメッセージで終了 MsgBox "該当データがありません" Exit Sub End If '4行目から最終行まで繰り返し For i = 4 To maxRow 'J列が日付であれば処理 If IsDate(inSheet.Cells(i, "J").Value) Then '--------機能しない箇所(開始) If Year(inSheet.Cells(i, "J").Value) <= Year(Me.TextBox21.Value) And _ Month(inSheet.Cells(i, "J").Value) <= Month(Me.TextBox21.Value) And _ CStr(inSheet.Cells(i, "W").Value) <> "受取済み" And CStr(inSheet.Cells(i, "W").Value) <> "注文中" Then '--------機能しない箇所(終了) inSheet.Rows(i).Copy outSheet.Rows(cnt + 2) End If End If Next i End Sub
- ベストアンサー
- その他（プログラミング・開発）
お礼
迅速なご回答ありがとうございました。 教えて頂いた手順でチェックしたところ、コードの穴を発見することができました。 （一番問題だったのは、変数ｓの宣言をWorksheetにしていなかったので、ブック名が ｓに代入されていた所でした） コードを組むときによりすっきりした実行手順も見えるようになったので、今後、 自力でマクロを作成する時に活用していきたいと思います。 大変勉強になりました。適切なご指導を頂きありがとうございました。