マクロを複数のシートに適用する方法
- マクロを使用して複数のシートに適用する方法について教えてください。
- ワークシートの名前を日付に変更するための記述と、31枚のシートに適用する方法を教えてください。
- Worksheet_Change関数を使用して、指定のセルが変更されたときにマクロが実行される方法について教えてください。
- ベストアンサー
マクロを複数のシートに適用する記述を教えて下さい
またまた、お世話になります。 いつも、丸投げの状態で申し訳ありません。 下記の「ワークシート名を日付を変更することで変えられる記述」を検索して見つけ、引用させて頂きました。 これを、度々変わるワークシート名に対応して、３１枚のシート（Ｓｈｅｅｔｎｏ３～３３）に適用したいのですが、 「どこに」 「どのような」 記述を加えたら、よろしいでしょうか？ どなたか、解る方がおられましたら、是非、ご教授いただけないでしょうか？ 毎度、カンニングで答えを見るような質問で恐縮しますが、よろしくお願いいたします。 Private Sub Worksheet_Change(ByVal Target As Excel.Range) On Error GoTo ERR: If Target.Cells(1, 1).Address = "$V$1" Then Me.Name = Target.Cells(1, 1).Text & "日" End If Target.Cells(1, 1).Select Exit Sub ERR: MsgBox "その名前には変更出来ません。", vbCritical + vbOKOnly, "ERROR" Resume Next End Sub
- yamagou
- お礼率75% (43/57)
- オフィス系ソフト
- 回答数1
- ありがとう数1
- みんなの回答 （1）
- 専門家の回答
質問者が選んだベストアンサー
全シートを対象にするのなら ThisWorkbookモジュールに記述します。 Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) 'シート名が"○△■"の場合は除外 If Sh.Name = "○△■" Then Exit Sub On Error GoTo ERR: If Target.Cells(1, 1).Address = "$V$1" Then Sh.Name = Target.Cells(1, 1).Text & "日" End If Target.Cells(1, 1).Select Exit Sub ERR: MsgBox "その名前には変更出来ません。", vbCritical + vbOKOnly, "ERROR" Resume Next End Sub
関連するQ&A
- 自動で複数セルの内容をシート名にする
今エクセル2013で、B5セルに「８」を入力して、C5セルには「月実績」と入力してあります。 Ｂ5セルはシートをコピーして月ごとに変更していきます。C5セルのほうも例えば「月生産数」等に変更して使用します。（つまり、B5もC5も両方内容を変更していきます。） このB5とC5のセルの内容をシート名に自動で変更したいのですが、どうすればよいでしょうか？ たとえば上記の例だと、シート名が「８月生産数」になってくれればよい。 今とりあえずWorksheetに下記コードを記述していますが、これだとシート名が「８$C$5」となってしまい、C5を文字で認識してしまい、セルの内容がシート名になりませんでした。 どうすればよいでしょうか？ また、記述場所は使っているシートのWorksheetにかきこめばよいでしょうか？（シート名を右クリックしてコードの表示ででてくる所に記述しています） VBAの事、あまり分からないままやっていますが、お願いいたします。 Private Sub Worksheet_Change(ByVal Target As Excel.Range) On Error GoTo ERR: If Target.Cells(1, 1).Address = "$B$5" Then Me.Name = Target.Cells(1, 1) & "$C$5" End If Target.Cells(1, 1).Select Exit Sub ERR: MsgBox "その名前には変更出来ません。", vbCritical + vbOKOnly, "ERROR" Resume Next End Sub
- ベストアンサー
- Excel（エクセル）
- マクロで空白のところをスルーするには？
いつも、お世話になりありがとうございます。 下記のマクロはあるところから、引用してきたセルU2の値（月日）をワークシート名に自動変換しているものですが、３１日に満たない２月、４月、６月、９月、１１月は、セルU2が空白になり、エラーになってしまう月があります。（１月から２月に変更する時など） セルU2が空白の場合、変換しない様にするには、 下記の記述の「どこに」「どの様な」記述と追加するか、或いは、削除するのかわかりません。 どなたか、ご教授いｔだけないでしょうか？ 初歩的な質問で、恐縮致しますが、よろしくお願いいたします。 Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) If Sh.Name = "勤務表""勤務表データ""マクロリスト表""マニュアル" Then Exit Sub On Error GoTo ERR: If Target.Cells(1, 1).Address = "$U$1" Then Sh.Name = Target.Cells(1, 1).Text End If Target.Cells(1, 1).Select Exit Sub ERR: MsgBox "その名前には変更出来ません。", vbCritical + vbOKOnly, "ERROR" Resume Next End Sub
- ベストアンサー
- オフィス系ソフト
- マクロ 複数のシートに適用する記述がわかりません
いつも皆様方にはたいへんお世話になっております。 下記のマクロをシート３～３３（同じ構造です）まで、適用したいのですが、一つ一つのシートに貼り付けていけばよいのですが、なんとか一つの記述で出来ないかと、以前この質問コーナーでの回答を寄せ集めて、記述したのですが、コンパイルエラーばかりで、どうにもなりません。 こんな初歩的なことは、最小限の勉強で解決出来るのかも知れませんが、どうにもなりません。 誠に恐縮ですが、下記の記述の「どこを」「どの様に」修正したらよいか、どなたか解る方、教えて頂けないでしょうか。 どうぞ、よろしくお願いいたします。 Private Sub worksheet_change(ByVal Target As Excel.Range) Dim sheetno As Integer ←この３行を当てずっぽうで挿入してみました＞＜； For sheetno = 3 To 33 Worksheets(sheetno).Select h As Range Set Target = Application.Intersect(Target, Range("E5:N12, E14:N22, E24:N28, E30:N34")) On Error Resume Next For Each h In Target If h <> "" Then Application.EnableEvents = False h = Application.VLookup(h.Value, Worksheets("マクロリスト表").Range("A:B"), 2, False) Application.EnableEvents = True End If Next End Sub
- ベストアンサー
- オフィス系ソフト
- EXCEL2003 VBAについて
EXCEL2003 VBAについて EXCEL2003で12個の同じ体裁の複数シートで構成されたブックがあります。 (1)シート1の[A1]に数値を入力するとシート名に文字列で構成された[E1]セルの内容を反映させる (2)シート2～12の[A1]セルにはシート1[A1]の値が入る (3)シート2～12にも[E1]の内容がシート名に反映される・・・はず (4) (1)処理時に自動的に(3)の処理が行われず、シート2～12に関しては、手動でA1をダブルクリックした後ESCキーでキャンセルし、シート名を更新しています。 しかしこの方法ですとこれをシート2～12全てでやらなければなりません。 (1)の入力だけで(2)を自動更新させる方法についてアドバイス頂けないでしょうか。 どうぞよろしくお願いします。 Sheet内スクリプト Private Sub Worksheet_Change(ByVal Target As Excel.Range) On Error GoTo ERR: If Target.Cells(1, 1).Address = "$A$1" Then Me.Name = Cells(1, 5) End If Target.Cells(1, 1).Select Exit Sub ERR: MsgBox "その名前には変更出来ません。", vbCritical + vbOKOnly, "ERROR" Resume Next End Sub
- ベストアンサー
- 会計ソフト
- マクロ 記述が悪くエラーがかかります。
いつも回答ありがとうございます。 最後らへんの記述で実行時エラー【型が一致しません】がかかります。 Worksheets("集計用").Range(b1, b2).Copy _ Destination:=Worksheets(b3).Range("B2") ← ここでエラーがかかる。 ワークシート名に変数を使用しているせいだと思います。 解決する方法を御指導して頂けないでしょうか？宜しくお願い致します。 Sub グラフの作成() Dim Date1 As Date Dim Date2 As Date Dim SName As String Dim b1 As Variant Dim b2 As Variant Dim b3 As Variant Dim d1 As Variant Dim d2 As Variant Dim d3 As Variant With Worksheets("集計用") s1: Date1 = Application.InputBox("最初の日付を2012/12/1のように入力してください。") If Date1 = 0 Then MsgBox "キャンセルされました。", vbOKOnly Exit Sub End If Set b1 = .Columns("B").Find(Date1, , xlValues, 1) If b1 Is Nothing Then If MsgBox("入力した日付が見当たりません。" & vbNewLine & _ "再度入力しますか？", vbYesNo) = vbYes Then GoTo s1 Else MsgBox "処理を中止しました", vbOKOnly Exit Sub End If End If d1 = b1.Row s2: Date2 = Application.InputBox("最初の日付を2012/12/31のように入力してください。") If Date1 = 0 Then MsgBox "キャンセルされました。", vbOKOnly Exit Sub End If Set b2 = .Columns("B").Find(Date2, , xlValues, 1) If b2 Is Nothing Then If MsgBox("入力した日付が見当たりません。" & vbNewLine & _ "再度入力しますか？", vbYesNo) = vbYes Then GoTo s2 Else MsgBox "処理を中止しました", vbOKOnly Exit Sub End If End If d2 = b2.Row s3: SName = Application.InputBox("商品名を入力して下さい。") If SName = "False" Then MsgBox "キャンセルされました。", vbOKOnly Exit Sub End If Set b3 = .Rows("3").Find(SName, , xlValues, 1) If b3 Is Nothing Then If MsgBox("入力した商品名が見当たりません。" & vbNewLine & _ "再度入力しますか？", vbYesNo) = vbYes Then GoTo s3 Else MsgBox "処理を中止しました", vbOKOnly Exit Sub End If End If d3 = b3.Column End With Worksheets.Add After:=Worksheets("集計用") ActiveSheet.Name = b3 Worksheets("集計用").Range(b1, b2).Copy _ Destination:=Worksheets(b3).Range("B2") Worksheets("集計用").Range(Cells(d1, d3), Cells(d2, d3)).Copy _ Destination:=Worksheets(b3).Range("C2") 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（エクセル）
- 複数のシートにコードを適用したい
excel vbaについての質問です （vbaについて初心者です） 現在、エクセルで勤務記録表を作成しています。 同じシートが70枚くらいあります。 各シートは同じ構成で、B6からC36までは時刻を打ち込み、 4ケタの数字を打ち込むと時間になるようにしたいと思っています。 例）1234⇒12：34 以下のようなコードを貼り付けているのですが vbaの編集をする「microsoft visual basic」というウインドウのところで、各シートをダブルクリックすると 出てくるウインドウに一つ一つ貼り付けないとうまく動きません ■全てのシートに貼り付けをしなくても動作する方法を教えて いただきたく、お願いします。 コードに誤りがあれば教えていただきたくお願いします。 （標準モジュールや「this workbook」にも貼り付けをしてみたのですが、思うようになりませんでした） 以下 ＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝ Private Sub Worksheet_Change(ByVal Target As Range) On Error Resume Next Dim 入力値 As Variant Dim 時 As Long Dim 分 As Long If Intersect(Target, Range("B6:C36")) Is Nothing Then Exit Sub 入力値 = Target.Value '1 If 入力値 = 0 Then 入力値 = terget.Value '2 ElseIf Target.Count <> 1 Then 'And (入力値 <> 0) Then ' メッセージを出す MsgBox "複数セル選択できません", vbCritical With Application .EnableEvents = False .Undo .EnableEvents = True End With '3 ElseIf VarType(入力値) <> vbDouble Then MsgBox "時刻を表す数字を入力してください。" ElseIf 入力値 < 1 Then Exit Sub Else 入力値 = Target.Value 時 = 入力値 \ 100 分 = 入力値 Mod 100 Application.EnableEvents = False Target.Value = TimeSerial(時, 分, 0) Application.EnableEvents = True End If End Sub
- ベストアンサー
- その他MS Office製品
- VBA シートがなかったら「シートがない」と表示
P1セルに「テスト」の名称を付ける。 P2セルにVLOOKUP計算式を入れる。最後尾までオートフィルでコピー。 といったコードです。 Sub テスト() Range("P1").Select ActiveCell.FormulaR1C1 = "テスト" nLast = Cells(Rows.Count, 1).End(xlUp).Row Range("P2:P" & nLast).Formula = "=VLOOKUP(K2,履歴!D:E,2,0)" End Sub もし「履歴」というシートがなかったら、「シートがありません」というメッセージウィンドウを」表示したいです。 https://oshiete.goo.ne.jp/qa/1043563.html を参考に Sub テスト() On Error GoTo err_handle Range("P1").Select ActiveCell.FormulaR1C1 = "テスト" nLast = Cells(Rows.Count, 1).End(xlUp).Row Range("P2:P" & nLast).Formula = "=VLOOKUP(K2,履歴!D:E,2,0)" err_handle: If Err = 9 Then MsgBox "シートAAAが存在しません。" Exit Sub End If End Sub と記述しましたが、エラーメッセージは表示しませんでした。 どのように追記したら良いでしょうか？ 宜しくお願いします。
- ベストアンサー
- Visual Basic
- シートのイベント ＶＢＡ
シートをクリックしたらシートをクリアしたいのですが クリックするセルがＡ１の場合は、マクロを実行させたくないのですが 下記のコードだとエラーになってしまいます。 Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Not Target.Range = Range("a1") Then Cells.Clear End If End Sub ”Range("a1")でなければ、Cells.Clearする” にはどうすればいいですか？
- ベストアンサー
- オフィス系ソフト
- Excelのマクロでシートを追加する際のエラー対策
久しぶりにExcelのマクロについて 質問させていただきます。 Sub シート追加() Dim シート名 As String, シート確認 As Worksheet シート名 = InputBox("シート名を入力してください") For Each シート確認 In Worksheets If シート確認.Name = シート名 Then MsgBox "同じ名前のシートがあります", vbCritical Call シート追加 End If Next ActiveSheet.Copy before:=ActiveSheet ActiveSheet.Name = シート名 End Sub 作ったマクロをごくシンプルにして 記載させていただきました。 これにより、シート名を付けて 次々とシートを追加しているのです。 問題は、すでに同じ名前のシートがあった場合です。 うっかり同じ名前を入力しても 「同じ名前のシートがあります」と表示され 「OK」を押すと改めて 「シート名を入力してください」 と表示されるようにしました。 しかし、なぜかこの場合 新たに入力したシート名でシートが作られるだけでなく そのシート名に「(2)」が付いたシートまで作られ 実行時エラー '1004': シートの名前をほかのシート、Visual Basic で参照されるオブジェクト ライブラリまたは ワークシートと同じ名前に変更することはできません。 というエラーが表示されてしまうのです。 Excel2010でもExcel2003でも同じでした。 ステップインでたどってみたのですが 「同じ名前のシートがあります」 が表示された場合 まだ使っていない名前のシートを作っても 黄色いままで「End Sub」から「End If」へ移ってしまいます。 ちなみに 「同じ名前のシートがあります」にならなければ 「End If」で終了したことになり 黄色は消えます。 詳しい方にはごく簡単なことなのでしょうが いろいろ検索しても答えは得られませんでした。 ご回答をよろしくお願いいたします。
- ベストアンサー
- Excel（エクセル）
お礼
早速、ご教授いただきありがとうございました。 見事に変更したいシートに適用できました。 ほんとうに助かりました。 「ThisWorkbookモジュール」というを教えていただき、また、少し進歩しました。 ありがとうございました。