• ベストアンサー

エクセルVBA:マクロの中にマクロ?

度々よろしくお願いします。ボタンが複数あって、それぞれに記録されたマクロの一部分が共通している場合の処理について教えてください。 例えば、前回の質問でご回答いただいたモノを流用し、別の処理と複合させたマクロがあります。 この変数ixがボタン(それぞれのマクロ)ごとに異なる場合、Do While以下を別のマクロとして記録し、それぞれのマクロの中で Application.Run "TEST.xls!Macro1"などのようにできるのでしょうか?変数の扱いをどうして良いのかわかりません。 Sub test() ~別の処理 ix = 8 Do While Cells(ix, "D") <> ""   Select Case Trim(Cells(ix, "D"))   Case "背筋"     Range("AZ8").Copy Destination:=Range(Cells(ix, "I"), Cells(ix, "AW"))   Case "アーム"     Range("BA8").Copy Destination:=Range(Cells(ix, "I"), Cells(ix, "AW"))   Case "レッグ"     Range("BB8").Copy Destination:=Range(Cells(ix, "I"), Cells(ix, "AW"))   End Select   Range(Cells(ix, "I"), Cells(ix, "AW")).Copy   Cells(ix, "I").PasteSpecial Paste:=xlPasteValues   ix = ix + 1 Loop Range("I8").Select End Sub

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

  • ベストアンサー
noname#29107
noname#29107
回答No.2

#1さんのように変数渡しにするか、以下のように共通で使用可能な変数として定義するのがいいでしょう。 Dim ix As Long '共通で使用したい変数はモジュールの冒頭で定義します。 Sub test() ix = 8 Call kyotsu1 '使用する共通コードの呼び出し Range("I8").Select End Sub Sub kyotsu1 Do While Cells(ix, "D") <> ""   Select Case Trim(Cells(ix, "D"))   Case "背筋"     Range("AZ8").Copy Destination:=Range(Cells(ix, "I"), Cells(ix, "AW"))   Case "アーム"     Range("BA8").Copy Destination:=Range(Cells(ix, "I"), Cells(ix, "AW"))   Case "レッグ"     Range("BB8").Copy Destination:=Range(Cells(ix, "I"), Cells(ix, "AW"))   End Select   Range(Cells(ix, "I"), Cells(ix, "AW")).Copy   Cells(ix, "I").PasteSpecial Paste:=xlPasteValues   ix = ix + 1 Loop End Sub

nonboo
質問者

お礼

たびたびありがとうございます。なるほどスッキリしますね。これからもよろしくお願いします。

全文を見る
すると、全ての回答が全文表示されます。

その他の回答 (1)

  • hana-hana3
  • ベストアンサー率31% (4940/15541)
回答No.1

sub Run1() dim Line as long line=8 call Test(line) 'Test を呼び出して、ix に Line の値を渡す。 end sub sub Test(ByVal ix as long)   range("Sheet1").select   Select Case Trim(Cells(ix, "D"))   Case "背筋"     Range("AZ8").Copy Destination:=Range(Cells(ix, "I"), Cells(ix, "AW"))   Case "アーム"     Range("BA8").Copy Destination:=Range(Cells(ix, "I"), Cells(ix, "AW"))   Case "レッグ"     Range("BB8").Copy Destination:=Range(Cells(ix, "I"), Cells(ix, "AW"))   End Select   Range(Cells(ix, "I"), Cells(ix, "AW")).Copy   Cells(ix, "I").PasteSpecial Paste:=xlPasteValues end sub

nonboo
質問者

お礼

ありがとうございました。このような方法で呼び出すのですね。感謝しております。

全文を見る
すると、全ての回答が全文表示されます。

関連するQ&A

  • エクセルのマクロについて

    エクセルのマクロについて 領域の範囲選択→貼り付けの繰り返し処理をループで考えています。 領域の範囲選択し、貼り付け処理をマクロの自動記録で、出してみました。 Sub Macro1() Range("E6:G12").Select Selection.Copy Range("E17").Select ActiveSheet.Paste Application.CommandBars("Stop Recording").Visible = False End Sub この時に、「Range("E17").Select」の命令は「Cells」関数に置き換えられるのですが、「Range("E6:G12").Select」のように複数のセルの領域選択をする際に、「Cells」関数ではできないのでしょうか。 「Cells」関数を使えば、行列を数値にし、変数を使えば、LoopかFor命令で繰り返し処理ができるのですが、わかる方、解答ください。よろしくお願いします。

  • excelのマクロでrangeの選択がうまくいきません。

    excelのマクロでrangeの選択がうまくいきません。 以下のマクロをsheet2に書きました。testcopyは動きますが、testcopy2は動きません。なぜなのでしょうか。どうすればいいのでしょうか。それ以外のマクロの部分との関係から、cellsを使い、数字を使ってrangeの処理をしたいのです。よろしくお願いします。 Sub testcopy() Worksheets("sheet1").Range("B3:C10").Copy Worksheets("sheet2").Range("e5").Select ActiveSheet.Paste End Sub Sub testcopy2() Worksheets("sheet1").Range(Cells(3, 2), Cells(10, 3)).Copy Worksheets("sheet2").Range("e5").Select ActiveSheet.Paste End Sub

  • エクセルの select case文

    Dim i For i = 1 To 5 Select Case Cells(i, "A") Case "午前" Range("w1").Select Selection.Copy  Cells(i, "C").Select ActiveSheet.Paste Case "午後" Range("x1").Select Selection.Copy Cells(i, "d").Select ActiveSheet.Paste  End Select Next i Dim j For j = 1 To 5 Select Case Cells(j, "A") Case "関東" Range("y1").Select Selection.Copy  Cells(j, "e").Select ActiveSheet.Paste Case "関西" Range("z1").Select Selection.Copy Cells(i, "F").Select ActiveSheet.Paste  End Select Next i 毎回皆様にはお世話になっています。 あるセルを参照してその入力結果により 違うセルを貼り付けるマクロを組みました。 参照するセルが複数個(この例だと2セル)あるので それぞれに変数を宣言してfor nextで まわしています。 この内容を変数ひとつだけで すっきりと記述することは可能でしょうか? 参照するセルや判別する内容が増えると 記述が膨大になって マクロが 見にくくなるので 良い方法がありましたら 御教授ねがいます。

  • エクセルのマクロでの質問です

    エクセルのマクロでの質問です。 やりたいことは、 明細シートから、「1.3.5」の条件に合うものを実績シートの最終行にコピーして追加していきたいんです。 これだと、実績シートの最終行にはコピーされるんですが 最終行に全部が上書きコピーされる状態になってしまってます。 どう直せば、追加される形になりますか? Sub コピー() '1,3,5のものを実績にコピーする i = 5 J = Sheets("実績").Cells(Rows.Count, 4).End(xlUp).Row + 1 Sheets("明細").Select Do While Cells(i, 8).Value <> "" If Cells(i, 3).Value = 1 Or Cells(i, 3) = 3 Or Cells(i, 3) = 5 Then Range("D5", "H5").Copy Sheets("実績").Select Range("C" & J).PasteSpecial Paste:=xlPasteValues Application.CutCopyMode = False End If i = i + 1 Loop End Sub まったくのマクロ初心者です。 分かりやすく教えていただけると、助かります。 また、参考になりそうなサイトなどがあったら、教えてください。

  • EXCELマクロについて

    条件 シート名提供データE列の3行目からデータが入っています。    ブランク以外のデータをコピーしてシート名WorkのC列の2行目から貼り付けたいので下記のマクロを書いていますがおかしい所 はないのでしょうか。教えてください。 いまいちCellsの使い方がわかりません。 出来たら下記の意味を教えてください。 brank = Worksheets("提供データ").Cells(gyo, 5).Text Range(Cells(3, 5), Cells(gyo, 5)).Select Sub 貼付() Dim gyo, brank Sheets("提供データ").Select Range("e3").Select gyo = 2 Do gyo = gyo + 1 brank = Worksheets("提供データ").Cells(gyo, 5).Text Loop While brank <> "" Range(Cells(3, 5), Cells(gyo, 5)).Select Selection.Copy Sheets("work").Select Range("c2").Select Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False End Sub

  • Excelマクロのことで教えて下さい

    初歩的なことですみません。 E列の値をF列に値を入れるために下記のマクロを組みました。 Sub test() Worksheets("Sheet1").Select Dim i As Long For i = 2 To Cells(Rows.Count, 4).End(xlUp).Row Range("F2").Value = "=E2/1024/1024" Cells(i, 6).FillDown Range(Cells(2, 6), Cells(i, 6)).Copy Range("F2").PasteSpecial Paste:=xlValues Next i End Sub ところがF列に「値のみを貼り付け」をした時に、途中から同じ値のみがコピーされてしまい困っています。 (画像参照) うまく貼り付けることができるマクロをお教え下さい。 よろしくお願いいたします。

  • 『エクセル』 vbaでオートフィルができない

    Sub Macro1() Range("a1:a10").Select Selection.AutoFill Destination:=Range("A1:A10"), Type:=xlFillSeries End Sub がエラーになります。 内容は「RangeクラスのAotofillメソッドが失敗しました」 となります。 Sub Macro2() Dim i As Long For i = 1 To 10 Cells(i, 1) = i Next End Sub や Sub Macro3() Dim i As Long i = 1 While i <= 10 Cells(i, 1) = i i = i + 1 Wend End Sub と同じような動きをAutoFillを使ってVBAで行いたいのですが むりでしょうか? というのも、 A1に長い関数式を入れて A10000までオートフィルしたいのですが 手作業だと時間がかかるためマクロで行いたいです。 アドバイス宜しくお願い致します。

  • エクセル2000マクロエラー

    下記のマクロを実行すると、Sheets(M_KAKOBA(count)).Selectのロジックでインデック スが有効範囲にありません。というエラーメッセージがでます。 エクセルのツール→オプション→全般→新しいシートの数を2から3に変更すると エラーは発生しないのですが、エクセルのツール→オプション→全般→新しいシートの数を2 のままでエラーを出さないようにするには、ロジックを変更すればできるのでしょうか? ロジックの追加方法を教えてください。 Sub 送信() '変数の設定 Dim work, hensu, i, j Windows("加工品.xls").Activate work = Sheets("masta").Cells(3, 6).Text 'シート名の変更 Windows(F_NAME).Activate Sheets(M_KAKOBA(count)).Select ActiveSheet.Name = work Windows("加工品.xls").Activate Sheets(work).Select i = 5 Do i = i + 1 hensu = Cells(i, 5) Loop While hensu <> "" Range(Cells(1, 1), Cells(i + 1, 33)).Select Selection.Copy Windows(F_NAME).Activate Sheets(work).Select Range("a1").Select Selection.PasteSpecial Paste:=xlAll, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Range("A2").Select End With Selection.BorderAround Weight:=xlThin, ColorIndex:=xlAutomatic ' '行の高さ If Worksheets(work).AutoFilterMode = False Then Range(Cells(5, 1), Cells(i + 1, 31)).Select Selection.AutoFilter End If End Sub

  • excelマクロについて

    下記のマクロを実行したときに、Sheets("提供データ")のD列の7327行目はブランクなのに、Sheets("jyoken")のa列の7326行目に計算式がコーピされるのはなぜでしょうか。 ちなみにSheets("jyoken")のa列の2行目に=提供データ!D3という計算式 が入っています。 Sheets("jyoken")のa列の7326行目には計算式がコーピしないようにするにはどこを修正すればよいのでしょうか教えてください。 Sub 式複写() Dim gyo, burank ActiveWorkbook.PrecisionAsDisplayed = False Sheets("提供データ").Select Range("a2").Select gyo = 2 burank = "" Do gyo = gyo + 1 burank = Worksheets("提供データ").Cells(gyo, 4).Text Loop While burank <> "" ' Sheets("jyoken").Select Range("A2").Select Selection.Copy Range(Cells(3, 1), Cells(gyo - 1, 1)).Select '複写先 ActiveSheet.Paste End Sub

  • マクロが実行しない

     二行三列を一枡として月の勤務割表を作成しています。マクロで同じ事を しているのにMacro1の方が実行しません。お教え願えませんでしょうか。 (尚、図形を枠線上にコピペしています。) Sub Macro1()実行しません。 Dim i As Integer Dim j As Integer For i = 10 To 43 Step 2 For j = 10 To 103 Step 3 Select Case Cells(i, j).Value Case 1: ActiveSheet.Shapes("四角形1").Select Selection.Copy Cells(i + 1, j + 1).Select ActiveSheet.Paste End Select Next Next End Sub Sub Macro2()実行します。 ActiveSheet.Shapes.Range(Array("四角形1")).Select Selection.Copy Range("J11:K11").Select ActiveSheet.Paste End Sub

このQ&Aのポイント
  • スキャナーヘッドから異音がして先へ進まない
  • 製品名:MFC-J837DN、OS:Windows10、接続方法:無線LAN、電話回線の種類:ひかり回線
  • 質問内容:ブラザー製品のMFC-J837DNでスキャナーヘッドから異音がして先へ進むことができません。OSはWindows10で接続は無線LAN、電話回線はひかり回線です。どうすれば解決できますか?
回答を見る

専門家に質問してみよう