• ベストアンサー
  • すぐに回答を!

マクロで二つの構文を繋ぐには

いつもお世話になります。 WIN7 EXCELL2010 です。 Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) If Target.Address = "$A$1" Then Sh.Name = Target.Range("A1").Value End Sub ThisWorkbook に上記のマクロに下記のマクロを追加したいのですが、 End Sub の ところを End If End With などに変えたのですがうまくゆきません。 御指導お願いできませんでしょうか。 Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) Dim myRange As Range Set myRange = Intersect(Target, Range("M3:V27")) If Not myRange Is Nothing Then Select Case Target.Value Case "" Target.Value = "○" Case "○" Target.Value = "●" Case Else Target.ClearContents End Select Cancel = True End If End Sub 宜しくお願いいします。

共感・応援の気持ちを伝えよう!

  • 回答数1
  • 閲覧数133
  • ありがとう数1

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

  • ベストアンサー
  • 回答No.1

単純に繋げればよいです。 処理の系統が違うのでどちらもEnd Subで完了させる必要があります。 (自動で区切りが入ります。) ただ、 Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) でなく、 Private Sub WorkBook_sheetBeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) では?

共感・感謝の気持ちを伝えよう!

質問者からのお礼

ありがとうございました。 ご指摘を頂いたのを実行しましたが作動しなくなり元に戻しました。

関連するQ&A

  • 同じシート内にイベントプロシージャが二つある時

    いつもお世話になります。 WINDWS7 EXCELL2010 です。 下記の1 2のマクロを同じシート内にイベントプロシージャを二つ挿入したところ、 ※1 ※2のような現象が起きました。 この現象を解決したくご指導を仰ぎたいです。 宜しくお願いします。 ※1 エラー表示 コンパイルエラー: 名前が適切ではありません; Worksheet_BeforeDoubleClick ※2 下記の構文が青色に反転 Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) 1 Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) If Intersect(Target, Range("A2:A51")) Is Nothing Then Exit Sub Cancel = True Sheets(CStr(Target.Value)).Select End Sub 2 Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) Dim myRange As Range Set myRange = Intersect(Target, Range("B2:B51")) If Not myRange Is Nothing Then Select Case Target.Value Case "" Target.Value = "○" Case Else Target.ClearContents End Select Cancel = True End If End Sub

  • マクロの疑問

    Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Target.Address <> "A2" Then Range("A2").Select End If End Sub とすると、どのセルを選んでもA2に飛ぶのに、 Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Target.Address = "A3" Then Range("A2").Select End If End Sub とすると、A3を選んでも全く移動しないのはなぜでしょうか。 なにか落とし穴がありそうで。。。 よろしくお願いします。

  • 二つの構文を繋げるのには

    よろしくお願いいたします。 WIN7 EXCELL2010 です。 重複を防止するために入力規則で防ごうとしましたがユーザーフォームでデーターシートに記入すると データー 入力規則 では コピー ペーストになりできないことが調べて分かりました。 そこでマクロを適用しようとおもいます。 現在下記のマクロは適用しています。 Private Sub Worksheet_Change(ByVal Target As Range) If Intersect(Target, Range("K2:M100")) Is Nothing Then Exit Sub 'ココで範囲指定 Application.EnableEvents = False If Target.Value = 1 Then Target.Value = "入昼" If Target.Value = 2 Then Target.Value = "入夕" If Target.Value = 3 Then Target.Value = "入朝" If Target.Value = 4 Then Target.Value = "退朝" If Target.Value = 5 Then Target.Value = "退昼" If Target.Value = 6 Then Target.Value = "退夕" If Target.Value = 11 Then Target.Value = "パ" If Target.Value = 12 Then Target.Value = "米" If Target.Value = 13 Then Target.Value = "粥" If Target.Value = 14 Then Target.Value = "ミ" If Target.Value = 15 Then Target.Value = "毎" Application.EnableEvents = True End Sub 上記のマクロに下記のマクロを追加したいのですがどう繋げていいいのかが分かりません。 END IF, END WITHでいろいろ試しましたがうまくいきません。 どう繋げればいいいかをご指導いただけませんでしょうか。 Private Sub Worksheeet_Change(ByVal Target As Rage) If Targeet.Count <> 1 Then Exit Sub If Targeet.Row > 10 Then Exit Sub If Targeet.Column <> 1 Then Exit Sub If Application.WorksheetFunction.CountIf(Range("O:O"), Target.Value) > 1 Then MsgBox "部屋番号と入所日が重複しています" Target.Value End If End Sub

  • エクセルのマクロ

    セルの値が変わったら動くマクロですが、2つ書くとエラーが出ます。 どのように直したらいいでしょうか? Private Sub Worksheet_Change(ByVal Target As Range) Select Case Target.Address If Intersect(Target, Range("EK22")) Is Nothing Then Exit Sub Else Range("EK24:EM28").Select Selection.ClearContents End If End Sub Private Sub Worksheet_Change(ByVal Target As Range) If Intersect(Target, Range("EK24")) Is Nothing Then Exit Sub Else Range("EK27:EM28").Select Selection.ClearContents End If End Sub

  • VBAで二つの構文を繋げるには

    いつもお世話になります。 WIN7 EXCELL2010 です。 1) A1に 数値化した日付を入力するとシート名表示に反映される。  例えば 2014/07/31 で A1 には 20140731 と入力するとシート名にも      20140731 が表示 Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) If Target.Address = "$A$1" Then Sh.Name = Target.Range("A1").Value End Sub 2) 1)で表示された複数のシートから今日のシート名になっているシートの色付けです。 Private Sub Workbook_Open() Dim mySheet As Worksheet For Each mySheet In Worksheets mySheet.Tab.ColorIndex = 19 If mySheet.Name = Format(Now(), "yyyymmdd") Then mySheet.Tab.ColorIndex = 3 End If Next End Sub 3) 各月をまとめたシートで シート名は 1&#65374;12 あります。 このシート名にも色付けするため下記マクロを追加したいのですが、1)のマクロとどう繋げばいいか分かりません。 Private Sub Workbook_Open() Dim sh As Worksheet     For Each sh In Worksheets         If isnumeric(sh.Name) Then             sh.Tab.ColorIndex = xlNone             If sh.Name = Month(Now) Then                 sh.Tab.Color = 255 ' 赤             End If         End If     Next End Sub 同じ Private Sub Workbook_Open() で始まるので丸められることが可能ならも含めていい方法を御指導いただけると幸甚です。 宜しくお願いします。

  • マクロでシート名を変更を変更したい

    A1セルの値をシート名にするマクロは以下のとおりだと思います。 Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) If Target.Address = "$A$1" Then Sh.Name = Target.Range("A1").Value End Sub では、E6セルの値をシート名にすることは可能でしょうか? よろしくお願いします。

  • Worksheet_changeイベントが動作しない

    Private Sub Worksheet_Change(ByVal Target As Range) Select Case Target.Address Case "$D$224" If Target.Value = "" Then Range("D224").Value = "-" End If End Select End Sub DeleteキーでD224をクリアした場合、D224に"-"が入力されません。 D224はD225と結合してあります。 select~caseを使ってdeleteキーで"-"が入力されるような動作を教えてください・・よろしくおねがいします。。。

  • D2に入力、B2に今日の日付のVBAを追加したいが

    いつもお世話になります。 WINDOWS7 EXCELL2010 です。 ご指導を仰ぎたいのは、 D2に顧客名(参照図では 田中) と入力したら B2に 今日の日付(2013/06/14)としたい。 追加する前のVBAは下記です。 Private Sub Worksheet_Change(ByVal Target As Range) If Target.Row >= 2 And Target.Address = Cells(Rows.Count, "C").End(xlUp).Address Then Target.Offset(0, -1).Value = Date End If Dim c As Integer If Target.Column <> 2 Then Exit Sub If Target.Value = "" Then c = 0 Else On Error GoTo line Select Case Month(Target.Value) Case 1: c = 46 Case 2: c = 4 Case 3: c = 39 Case 4: c = 6 Case 5: c = 7 Case 6: c = 8 Case 7: c = 43 Case 8: c = 3 Case 9: c = 44 Case 10: c = 24 Case 11: c = 40 Case 12: c = 17 End Select End If Target.Offset(0, -1).Interior.ColorIndex = c Target.Offset(0, -1).Font.ColorIndex = IIf(c = 1, 2, 0) Exit Sub line: Target.Offset(0, -1).Interior.ColorIndex = 0 Target.Offset(0, -1).Font.ColorIndex = 0 End Sub 上のマクロに下記のマクロを追加すると参照図のようなエラーが表示されます。 下記のマクロの何かが間違っていると考えています。 Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) If Intersect(Target, Range("D2:D100")) Is Nothing Then Exit Sub If ActiveCell = "" Then ActiveCell = Date Cancel = True End If End Sub ご指導いただけるとうれしいです。

  • 【ExcelVBA】 既にあるマクロの間で実行させたいのです。

    こんにちは 下のマクロを・・・ Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) Const RangeName As String = "●入力" If Not Intersect(Range(RangeName), Target) Is Nothing Then Cancel = True If Target = "●" Then Target = "" Else Target = "●" End If End If End Sub このマクロの■ここで実行■で実行させたいのですが、どのようにしたらよいでしょう。 Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) If Target.Address <> "$D$1" Then Exit Sub Cancel = True Columns("A:U").Select Range("T1").Activate Selection.Sort Key1:=Range("D2"), Order1:=xlAscending, Header:=xlYes, _ OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _ :=xlPinYin, DataOption1:=xlSortNormal Selection.Replace What:="ああ", Replacement:="", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ ReplaceFormat:=False Range("D1").Select End Sub ■ここで実行■ Private Sub Worksheet_Change(ByVal Target As Range) strAddress = "A1:A2000" On Error GoTo ErrorHandler If Target.Count > 1 Then GoTo ErrorHandler If Not Intersect(Target, Range(strAddress)) Is Nothing Then Application.EnableEvents = False Range(strAddress).ClearContents Target.Value = "●" End If ErrorHandler: Application.EnableEvents = True End Sub

  • エクセル イベントマクロのエラー回避

    イベントマクロを初めて書いてみたのですが A列を全部選択して削除などをするとエラーがて出てしまいます 回避するにはどのようにしたら良いのでしょうか? Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Range("A:A")) Is Nothing Then Select Case Target.Value Case Is = "りんご" cellColor = 3 Case Is = "みかん" cellColor = 6 End Select End If If Not Intersect(Target, Range("B:B")) Is Nothing Then Select Case Target.Value Case Is = "りんご" cellColor = 6 Case Is = "みかん" cellColor = 3 End Select End If Target.Interior.ColorIndex = cellColor End Sub 以上が書いたものです。 皆様の知恵お貸しください 宜しくお願いします。