Excel2003のVBAで複数シートでマクロを実行する方法

このQ&Aのポイント
  • Excel2003のVBAで1つのマクロを複数のシートで実行したいですが、方法が分かりません
  • 具体的には、指定したシート(例:シート2,5,8)でマクロを実行したいです
  • VBA初心者ですので、1文ごとに簡単なコメントや参考書やURLも教えていただきたいです
回答を見る
  • ベストアンサー

Excel2003 1つのマクロを複数シートで実施

初めて質問をさせていただきます。文面など、分かりにくい部分も 多々あるかと思いますが、ご容赦ください。 Excel2003のVBAで1つのマクロを複数のシートで実行したいのですが、 上手くできません。過去のQAも拝見しているのですが、 思うように動かずです。 具体的には Sub カレンダー作成G5() Dim 日数 As Long Dim 日付 As Variant Dim 月 As Integer, 年 As Integer Dim 入力セル As Range 日付 = Application.InputBox _ ("yyyy/m 形式の年月を半角で入力してください" & Chr(10) _ & " 例)2013年の1月 → 2013/1") If 日付 = False Or IsDate(日付) = False Then Exit Sub End If 月 = Month(日付) 年 = Year(日付) Range("c3").Value = DateSerial(年, 月, 1) Range("G5:Ak5").Select Selection.ClearContents 日数 = 0 For Each 入力セル In Selection 入力セル.Formula = "=$c$3+" & 日数 日数 = 日数 + 1 If 月 <> Month(Range("c3") + 日数) Then Exit For Next End Sub です。これを、1ブックのシートが1~10ある中から、例えば「シート2,5,8」と言った具合に、 複数のシートで実施したいのです。 (選択するシートは固定ですが、今後のシートの追加は、可能であれば想定したいです。)  なお、この記述も、前任者の記述であり、当方はまったくの未経験者とご認識ください。 従いまして、後学の為、1文ごとに簡単なコメントなどをいただけますと、本当にありがたく。 (さらに欲を申し上げますと、VBA初心者にお勧めの参考書やURLもご紹介いただけますと幸いです。)  また、OKwaveのシステムも理解できておりませんので、お礼も言葉のみとなってしまいます。 その点も、ご理解いただけますと幸いです。  ぜひとも「無知な人間に勉強する機会を」いただけましたらと思います。 有識者のみなさま、ご指導をよろしくお願いいたします。

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

  • ベストアンサー
  • mu2011
  • ベストアンサー率38% (1910/4994)
回答No.4

NO2です。 一例です。 全シートを検索して対象のシート("Sheet2", "Sheet5", "Sheet8")に日付を展開します。 Sub カレンダー作成2() Dim 日付, i As Integer 日付 = Application.InputBox _ ("yyyy/m 形式の年月を半角で入力してください" & Chr(10) _ & " 例)2013年の1月 → 2013/1") If 日付 = False Or IsDate(日付) = False Then Exit Sub For i = 1 To Sheets.Count With Sheets(i) Select Case .Name Case "Sheet2", "Sheet5", "Sheet8" .Range("G5").Resize(, 31).ClearContents .Range("C3,G5").Value = DateSerial(Year(日付), Month(日付), 1) .Range("G5").AutoFill Destination:=.Range("G5"). _ Resize(, Day(DateSerial(Year(日付), Month(日付) + 1, 0))) End Select End With Next End Sub

rosso13
質問者

お礼

ご連絡が遅くなってしまい、本当に申し訳ありません。 できました!感動です!すごいです!  正直に申し上げて、内容理解にはまだ時間がかかりますが、 いずれにしましても、解決いたしました。  本当にありがとうございます。数ある質問の中で、私が 掲載した質問に目を留めていただけた事に深く感謝いたします。  今後も引き続き、色々と質問を掲載する機会があるとは 思いますが、ご縁がありましたらぜひまたお願いいたします。

その他の回答 (3)

  • tom04
  • ベストアンサー率49% (2537/5117)
回答No.3

こんにちは! すでにマクロがありますので、 >1つのマクロを複数のシートで実行したいのですが・・・ とありますが、別マクロを標準モジュールに作り、今のマクロを実行させる方法はどうでしょうか? Alt+F11キー → すでにあるマクロの下に下のコードをコピー&ペーストして 追加した「複数Sheet操作」マクロを実行してみてください。 Sub 複数Sheet操作() Dim k As Long, str As String, myArray str = Application.InputBox("操作したいSheet番号を" & vbCrLf & _ "2,4,5のようにカンマ区切りで入力してください。") 'インプットボックスにカンマ入力があれば If InStr(str, ",") > 0 Then 'カンマで入力値を区切って、格納する myArray = Split(str, ",") 'カンマで区切った最初の文字~最後の文字まで For k = 0 To UBound(myArray) 'k番目のSheetをactiveに Worksheets(Val(myArray(k))).Activate 'マクロを実行 Call カレンダー作成G5 '次のSheetに! Next k 'インプットボックスにカンマ入力がない場合(一つのSheetのみに場合) Else 'アクティブなSheetにマクロを実行 Call カレンダー作成G5 End If End Sub こんな感じではどうでしょうか?m(_ _)m

rosso13
質問者

お礼

 ご連絡が遅くなってしまい、申し訳ありません。 また、非常に丁寧なコメントまで掲載していただき、 重ねて御礼申し上げます。  「なるほど!」の一言に尽きます。感服いたしました。  こういった方法もあるのですね。1つの目的に対して、 さまざまなアプローチの仕方があるのだと、今回お教え いただいた内容を拝見し、思いました。  まだまだVBAに対して、駆け出しどころか「準備運動」の 状態ですので、しっかりと勉強したいと思います。  貴重なお時間をいただき、ご教授いただきまして、 本当にありがとうございました。今後もVBA関連で質問させて いただくことがあると思います。この名前を見たときには、 ぜひまたよろしくお願いいたします。

  • mu2011
  • ベストアンサー率38% (1910/4994)
回答No.2

>1つのマクロを複数のシートで実行したい  ⇒各シートで実行したいのなら、標準モジュールに登録して、対象シートをアクティブにして実行すればOKです。   それとも1回の年月入力で複数の固定シートに同一カレンダを展開したいのでしょうか。

rosso13
質問者

お礼

コメントいただきありがとうございます。 心よりお礼申し上げます。 その上で、お教えください。 >それとも1回の年月入力で複数の固定シートに同一カレンダを >展開したいのでしょうか。 ⇒ご推察の通りです。まさに仰っている形にしたいのですが、  お恥ずかしい話なのですが、  私の知識では到底できるはずがない状況でございます。  もしも可能であれば、質問させていただいた記述に対して、 付記していただく形で、ご教授願えないでしょうか? ご面倒をおかけすることを承知で、ご無理を申し上げております。 ぜひとも、よろしくお願いいたします。

回答No.1

マクロは標準モジュールだとして、activesheet.nameにより実行を制御すればイイのでは??

rosso13
質問者

お礼

コメントいただきありがとうございます。 心よりお礼申し上げます。  その上で、さらにご教授いただきたく。 >マクロは標準モジュールだとして、activesheet.nameにより >実行を制御すればイイのでは?? ⇒ 仰るとおり、マクロは標準モジュールに設定されています。  後半部の「activesheet.nameにより~」の部分が、  申し訳ありません。よく・・・分かりません。  大変お手数だとは思うのですが、私が記述いたしました 内容に「追記」していただく形で、ご教授願えないでしょうか? ぜひとも、よろしくお願いいたします。

関連するQ&A

  • VBA マクロについて

    自作のカレンダーに自動で日付を判定、入力してくれる ロジックを作っていたのですが、 2、4、6、9、11月以外は31日分表示されるはずが。。。 表示されませんでした。 恐らくロジックがおかしくて i=31 が通っていないものと 思われますが、ちょっとよく分かりません。 初心者で低レベルな質問ですけど、どなたかお願いします。 Sub AutoCarender() '自動でカレンダーの日付を入力するプログラム Dim month, i As Integer '表示させたい月 month = 3 If (month = 2) Then i = 28 ElseIf (month = 4 Or 6 Or 9 Or 11) Then i = 30 Else i = 31 End If Dim tate, yoko As Integer Dim week As Integer week = (Weekday(2009 / month / 1, 2)) yoko = Choose(week, 1, 3, 5, 7, 9, 11, 13) tate = 3 For j = 1 To i '"シートの名前"を指定 Worksheets("Sheet1").Cells(tate, yoko).Value = j yoko = yoko + 2 If (yoko > 13) Then yoko = 1 tate = tate + 2 End If Next End Sub

  • エクセルマクロvbのchangeイベントで複数入力した時フリーズして困っています

    マクロ初心者で困っています。 セルに『新規』と入力すると、T2セルに『F』と表示されるようにしたのですが、 『新規』をコピーして複数セルに貼り付けると貼り付けた状態のままパソコンが動かなくなってしまいます。 複数のセルがchangeした場合、マクロを終了する方法はないでしょうか? 教えて下さいm(_ _)m Private Sub Worksheet_Change(ByVal Target As Range) Dim tr As Integer Dim x As String If Intersect(Target, Range("H4:H253")) Is Nothing Then Exit Sub x = Target.Value tr = Target.Row If x = "" Then Exit Sub If x = "新規" Then Range("T2") = "F"   End sub

  • EXCELマクロでシート作成&シート名をつける方法

    EXCELでセルK列に入力した名称でシートをどんどん作成したいのですが、 下記のようにやってみましたが、うまく実行されません。 2回目の←の部分で、終わってしまいます。 詳しい方、教えてください。 Sub Macro3() Dim neSheet As String Dim fMax As Integer Dim num As Integer Dim i As Integer fMax = Range("B2").Value num = 2 For i = 1 To fMax neSheet = Range("k" & num).Value Worksheets.Add(After:=Worksheets(1)).Name = neSheet ← num = num + 1 Next i End Sub

  • マクロ作動

    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回マクロが作動出来ればいいです

  • エクセルマクロについて助言下さい。

    エクセルマクロについて助言下さい。 ★やりたい事 シート名を指定しアクティブにする BOOOKに複数のセルがあり、シート名は日付(1・2など) 但し、必ず連続ではなく1~31までのシートが存在します。 現在のマクロ↓ シート名を取得し関数で指定のシートが存在するか確認しています。 作業シートのC1セルが0で指定シートなし 0でないで指定シートあり(処理開始)としてます。 作業2のI3セルに日付データがあります。 Sub 抽出() 'シート名を取得する Sheets("作業").Select Dim i As Integer Dim mySheetCnt As Integer Dim mySheetNam As String    mySheetCnt = ThisWorkbook.Sheets.Count For i = 1 To mySheetCnt mySheetNam = Sheets(i).Name Sheets("作業").Cells(i, 1) = mySheetNam Next i   Range("A1").Select If ActiveCell.Value = "" Then 'A1が空白の場合の処理 MsgBox "指定の日付のシートが存在しません" Exit Sub End If Sheets("作業").Select Range("C1").Select If ActiveCell.Value = 0 Then 'C1が0の場合の処理 MsgBox "指定の日付のシートが存在しません" Exit Sub End If Sheets("作業2").Select Range("I3").Select Sheets(ActiveCell.alue).Select End Sub このコードだと3と指定すると左から3枚目にあるシートが選択されます。 3枚目ではなくシート名が 3 を選択したいのです。。 分かりにく説明で申し訳ありませんが、教えてください。

  • Excel2007 マクロ 複数シートの作成

    Excel2007 マクロ 複数シートの作成 1つのファイルにtempシートとDataシートがあります。 DataシートのNo順にシートをコピーしていきます。 シートのコピーはうまくいきました。 Dataシートの情報(会社名、担当者名)を反映したいのですが うまく反映しません。 自分が作成したマクロを下記に記載いたします。 Sub CreateSheet() Dim lnFm As Long Dim lnFmMx As Long Dim st As String Dim shFm As Worksheet Dim shTo As Worksheet Set shFm = Worksheets("Data") lnFmMx = shFm.Range("B65536").End(xlUp).Row Dim Into As Long For lnFm = 2 To lnFmMx If st <> shFm.Range("B" & lnFm).Value Then st = shFm.Range("B" & lnFm).Value Sheets("temp").Copy After:=Sheets(2) Set shTo = ActiveSheet shTo.Name = st Into = 1 End If shTo.Range("B1" & Into).Value = shFm.Range("B2" & lnFm).Value shTo.Range("B2" & Into).Value = shFm.Range("C2" & lnFm).Value Next shFm.Activate End Sub 下記2行が違うと思うのですが、修正箇所が分かりません。 shTo.Range("B1" & Into).Value = shFm.Range("B2" & lnFm).Value shTo.Range("B2" & Into).Value = shFm.Range("C2" & lnFm).Value また実際のNo数は50ぐらいあります。 アドバイス頂けますでしょうか。

  • エクセルVBAで指定したセルへジャンプするコード(追加の追加質問です)

    http://oshiete1.goo.ne.jp/qa2903797.html たびたびすみません。最後にひとつだけお願いします。 お教えいただいた下のコードは順調に動作するのですが、 対象セルが結合セルの場合、エラーが出てしまいます。 とまってしまうコードの部分は With Selection.AddComment です。 エラーメッセージにはプロシージャの呼び出し、 または引数が不正です。(Error 5)と書いてあります。 結合セルは動作しないものでしょうか? Sub test01() Dim x As String Dim ThisSheet_Name As String Dim Sheet_Name As String Dim Range_Name As String Dim I As Integer, n As Integer Dim Ans As Integer Dim myComment As String '新規追加 Dim Colors As Integer '新規追加 ThisSheet_Name = ActiveSheet.Name '設定シート Select Case Workbooks.Count Case 1 MsgBox "チェックするファイルがありません。" Exit Sub Case 2 For n = 1 To 2 If Workbooks(n).Name <> ThisWorkbook.Name Then x = Workbooks(n).Name '開いている“もうひとつのブック”の名前 End If Next Case Else MsgBox "他に開いているファイルが複数のため対象を特定できません。" Exit Sub End Select I = 0 Do While (1) With ThisWorkbook.Sheets(ThisSheet_Name) If .Range("A3").Offset(I, 0).Value = "" Then MsgBox "検査項目は以上です。" ThisWorkbook.Activate Exit Do 'A列の3行目以下が、空白なら終わる End If Sheet_Name = .Range("A3").Offset(I, 0).Value Range_Name = .Range("B3").Offset(I, 0).Value myComment = .Range("C3").Offset(I, 0).Value End With Windows(x).Activate Sheets(Sheet_Name).Select Range(Range_Name).Select Colors = Selection.Interior.ColorIndex '新規追加 Selection.Interior.ColorIndex = 6 With Selection.AddComment .Visible = True .Text myComment End With Range(Range_Name).Select Ans = MsgBox("「次をチェックしますか?」", vbYesNo) Selection.Interior.ColorIndex = Colors '修正 Selection.ClearComments '新規追加 If Ans = vbYes Then I = I + 1 Else Exit Do End If Loop End Sub

  • EXCEL2003から2010への互換エラー

    EXCEL2003で使っていたファイルを2010で開いたらコードが反応しなくなりました。 直す方法を教えてください。 具体的にはあるセルに入力すると別シートの「申請書」を印刷するというコードを入れています。 Private Sub worksheet_change(ByVal Target As Excel.Range) Dim h As Range Set h = Application.Intersect(Target, Range("AA15:AA45")) If h Is Nothing Then Exit Sub If h.Cells(1) = "" Then Exit Sub If MsgBox("申請書印刷しますか?", vbOKCancel) <> vbOK Then Exit Sub Worksheets("申請書").PrintOut End Sub よろしくお願いいたします。

  • エクセル 複数シート( VLOOKUP ユーザー定義関数

    複数シート(範囲)を指定できるVLOOKUP関数をユーザー定義で作りたいと思ってます。下記のコードではうまく動かないので教えてください。 Function VLOOKUPM(検索値 As Variant, 対象シート As String, 対象セル As Range, 列番号 As Integer) As Variant Dim i As Integer Dim r As Range Dim sh As Variant Application.Volatile sh = Split(対象シート, ",") For i = 0 To UBound(sh) Set r = Sheets(sh(i)).Range(対象セル) If 検索値 = r Then VLOOKUPM = r.Offset(0, 列番号) Exit Function End If Next End Function

  • Excel2007 マクロについて

    たとえばですが sheet1のF5列をダブルクリックすると、その左側にあるA5の値をコピーし sheet2のA列の未入力行へ貼り付けするにはどうしたらよいでしょうか Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Excel.Range, cancel As Boolean) If Intersect(Target, Range("F:F")) Is Nothing Then Exit Sub cancel = True End Sub とりあえずここまで作って開くことは開いたのですが、その先がわからず困っております。 よろしくお願いいたします。

専門家に質問してみよう