Excel マクロを各シートごとに実行したい

Question

マクロ初心者です。

エクセルブックでシフトの管理をしています。
一日分の各ワークシートごとに必要な作業をしてから
同じ部分を、並べ替えして不要な部分を削除したいのです

以下はシート７で、作業をして記録したマクロです。
これを各アクティブシートごとに同じマクロで実行したいのですが
うまく書き換えできませんでした。
どのように変更すればいいのか、教えてください。
よろしくお願いします。
-------------------------------------------------------
Sub Macro1()
'
' Macro1 Macro
'
' Keyboard Shortcut: Ctrl+m
'
    Range("A36:O77").Select
    ActiveWorkbook.Worksheets("7").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("7").Sort.SortFields.Add Key:=Range("A36:A77"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("7").Sort.SortFields.Add Key:=Range("N36:N77"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("7").Sort.SortFields.Add Key:=Range("O36:O77"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("7").Sort
        .SetRange Range("A36:O77")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Rows("35:35").Select
    Selection.AutoFilter
    ActiveSheet.Range("$A$35:$DN$78").AutoFilter Field:=14, Criteria1:="0:00"
    Rows("36:59").Select
    Selection.Delete Shift:=xlUp
    ActiveSheet.Range("$A$35:$DN$65").AutoFilter Field:=14
    ActiveSheet.Range("$A$35:$DN$65").AutoFilter Field:=14, Criteria1:="=*(*)*" _
        , Operator:=xlAnd
    Rows("44:63").Select
    Selection.Delete Shift:=xlUp
    ActiveSheet.Range("$A$35:$DN$55").AutoFilter Field:=14
End Sub

WindFaller · Accepted Answer

考えてみました。画面をみないと、想像が付かないものがあるものですね。質問にあるマクロをみると、最初あった、　Range("$A$35:$DN$78")　これが、だんだん、Rows("44:63").Select　とずれていますが、これは、削除した後に再度設定しなおしたからです。だから、まとめて行ってしまえばよいということだと思います。 >実際のシートのデータは　Ａ35　～　ＣＣ77までで　（,81）の部分ですが、　Set Rng = .Range("A35:DN" & Lr)　のDNの部分を書き換えてください。 ※一番大事な所は、この部分です。　Lr = Cells(Rows.Count, "B").End(xlUp).Row　' この数字を使いまわしします。B列というのは、結合セルがあると、A列には値が入っているけれども、B列は空になっているからです。マクロのそのLrに、ブレークポイント（●）を入れて、ローカルモジュールなどで、数字か取れているか、最初に見たほうがよいでしょう。ブレークポイントが面倒なら、 Msgbox LR を貼り付けてもよいです。ここが取れていなかったら、アウトです。とれていないなら、リテラル値（あらかじめ数字を入れること）になってしまいますから、先頭はともかく、最後行をマクロで探さないと、二度目はまたエラーが出てしまいます。たぶん、私が、マクロに対してどう考えているかは、以下のコードを見れば分かっていただけるように思います。 '// Sub TestMacro2() 　　Dim Rng As Range 　　Dim Lr As String 　　Dim a As String, b As String 　　Dim Ur As Range 　　' Keyboard Shortcut: 　　With ActiveSheet 　　　　Lr = Cells(Rows.Count, "B").End(xlUp).Row　'ここで最後の行数をとっている　　　　　　　　Set Rng = .Range("A36:O" & Lr)　'最初の範囲　　　　　　　　If .AutoFilterMode Then 　　　　　　 .AutoFilterMode = False 　　　　End If 　　　　With Rng 　　　　　　.Sort Key1:=.Cells(1, 1), Order1:=xlAscending, _ 　　　　　　Key2:=.Cells(1, 14), Order2:=xlAscending, _ 　　　　　　Key3:=.Cells(1, 15), Order3:=xlAscending, _ 　　　　　　Header:=xlYes, OrderCustom:=1, MatchCase:=False, _ 　　　　　　Orientation:=xlTopToBottom, SortMethod:=xlPinYin 　　　　End With 　　　　'行の削除の部　　　　Set Rng = .Range("A35:DN" & Lr)　'CCまでなら、DN → CC と変えてください。　　　　　　　　Rng.AutoFilter Field:=14, Criteria1:="0:00" 　　　　　　On Error Resume Next 　　　　　　If Application.Subtotal(3, Rng.Columns(1)) > 1 Then 　　　　　　　　a = Rows("35:" & Lr).SpecialCells(xlCellTypeVisible).Address(0, 0) 　　　　　　End If 　　　　　　.ShowAllData 　　　　　　　　　　　　Rng.AutoFilter Field:=14, Criteria1:="=*(*)*" 　　　　　　If Application.Subtotal(3, Rng.Columns(1)) > 1 Then 　　　　　　　　b = Rows("35:" & Lr).SpecialCells(xlCellTypeVisible).Address(0, 0) 　　　　　　End If 　　　　　　　　　　　　If a <> "" Then　'セルの範囲のまとめ　　　　　　　　Set Ur = Range(a) 　　　　　　　　If a <> "" And b <> "" Then 　　　　　　　　　　Set Ur = Union(Range(b), Ur) 　　　　　　　　ElseIf b <> "" Then 　　　　　　　　　　Set Ur = Range(b) 　　　　　　　　End If 　　　　　　End If 　　　　　　.ShowAllData 　　　　　　If Len(a & b) > 0 Then 　　　　　　　　Ur.Delete　'一度に削除　　　　　　End If 　　　　　　 If .AutoFilterMode Then 　　　　　　 .AutoFilterMode = False 　　　　　　 End If 　　　　End With End Sub

WindFaller · Answer

#3の回答者です。

Ln = 36,77
Cl = 15　という表記でいいのでしょうか？
いえ、こういうつもりはなかったのですが、これで活かせるようにも出来ます。

ただ、その前に、根本的な問題なのですが、もしかしたら、オートフィルタは削除のために便宜的にお使いになったのですか？

私が読んだ、VBAの教本でも、行をまとめて削除する場合に、その方法は技術的に、ベストな選択だそうですが、掲示板ではあまり見かけないスタイルです。私自身は、そういうコードを書いたことがありますが、あまりウケないコードのようです。凝った方法でしたので、思わず、自分の知っいる方法と勘違いしてしまいました。

実際に、35行目に結合セルがあるという前提からだと、かなり手直ししなければなりません。

てっきりオートフィルタ自体を使っているものだと思ったので、そのようなコードになりました。もう少し全体を読むべきでした。

少し時間をください。読みなおしてみます。

WindFaller · Answer

こんにちは。

私は、VBAの難しいことや新しいことは、もう分かりませんが、旧ソート・メソッド（質問では、ソート・オブジェクト）で作ってみました。

オートフィルタの　検索値　"=*(*)*"　の意味がよく分かりませんでした。
まとめてシートに対して行うなら、シートを引数にして、サブルーチンにすればよいと思います。

ただ、シートごとに、以下の部分が違う場合は、それを決定するマクロを加えなくてはいけません。
Ln = 35 'Row Beginning 行の始まり
Cl = 15 'Column Width 列の幅

Range範囲のオブジェクトさえ見失わなければ、とても単純で簡単なマクロです。他の要件は読んでいませんので、読み落としていたら、おっしゃってください。できることなら、やってみます。

行の削除の問題は、私の記憶では、下位バージョンでは、そのままでは、まとめて選択して見える部分だけ削除が可能、ということは出来なかった覚えがあります。時々、成功しないということを耳にすることがあります。その場合は、SepecialCells で可視セルだけを選択するというのですが、今回は、それが逆に、そちらがうまく行かないという現象が起こりました。

マクロを行った後は、後戻が利きませんので、バックアップを取るなりに気をつけてお使いください。

'//
Sub TestMacro1()
Dim Rng As Range
Dim Ln As Long
Dim Cl As Long
Dim AcSh As Worksheet
Set AcSh = ActiveSheet

'並べ替えの部
Ln = 35 'Row Beginning 行の始まり
Cl = 15 'Column Width 列の幅
With AcSh
'オートフィルタモードの解除
If .AutoFilterMode = True Then
　　 .AutoFilterMode = False
End If
Set Rng = .Range(.Cells(Ln, 1), .Cells(Rows.Count, 1).End(xlUp).Resize(, Cl))
End With
With Rng
　.Sort Key1:=.Cells(1, 1), Order1:=xlAscending, _
　　 Key2:=.Cells(1, 14), Order2:=xlAscending, _
　　 Key3:=.Cells(1, 15), Order3:=xlAscending, _
　　 Header:=xlYes, OrderCustom:=1, MatchCase:=False, _
　　 Orientation:=xlTopToBottom, SortMethod:=xlPinYin
End With
　'オートフィルタの部
　With Rng.Resize(, 118)　　'拡張　DN列まで
　If AcSh.AutoFilterMode = True Then
　　　　AcSh.AutoFilterMode = False
　End If
　　　　.AutoFilter
　　　　.AutoFilter Field:=14, Criteria1:="0:00"
　End With
　With AcSh.AutoFilter.Range
　　 '行の削除
　　　　If Application.Subtotal(3, .Columns(1)) > 1 Then
　　　　　　.Offset(1).Resize(.Rows.Count - 1).Delete Shift:=xlUp
　　　　End If
　　　　AcSh.ShowAllData　'フィルタのデータだけ開く
　　　　'再度
　　　　.AutoFilter Field:=14, Criteria1:="=*(*)*"
　　　　If Application.Subtotal(3, .Columns(1)) > 1 Then
　　　　　　.Offset(1).Resize(.Rows.Count - 1).Delete Shift:=xlUp
　　　　End If　　　　
　　　　.AutoFilter　　'Autofilter 終了
　　End With
End Sub

fujillin · Answer

ANo1です。

＞ただ後半のフィルター削除が、うまく動作せずに、不要な行が少しづつ
＞残ってしまいます。なにか解決策ありますでしょうか？
マクロの自動記録で作成したものは、その時の操作をそのままの記述になるので、なさりたいことの一般的な記述とは異なる場合があり得ます。
（例えば、今回のご質問のようにアクティブシートが対象になっていないとか）

回答者には、提示されたコードしかないのでそれがそのままなさりたいことと考えるしかなく、文法的におかしな点などがない限りは、どこがおかしいかを指摘することはできません。
ご提示のコードの後半はオートフィルター操作と行の削除からなっていますが、考えられるのは・・・
◇オートフィルターに関して
　・範囲の指定が正しいか？（いつも固定の同じ範囲なのか）
　・パラメータの指定が正しいか？
◇消去に関して
　・範囲の指定が正しいか？（いつも固定の同じ範囲なのか）

といったところをチェックなさってみるのが宜しいかと思います。
（なさりたいことと、本当に一致した指定になっているかどうかの確認）

幸い、使用しているメソッドは少ないので、以下をご参照の上、パラメータ等の意味するところを理解してチェックしてみてください。
https://msdn.microsoft.com/ja-jp/library/office/ff193884.aspx
https://msdn.microsoft.com/ja-jp/library/office/ff834641.aspx

※ まったくの想像ですが・・・
ご提示のコードでは消去する行の範囲が一律で固定になっていますが、実際は、人間が何らかの判断をして、消去範囲を決めているのかも知れません。
もしも、そのような場合は、そのための条件から計算して消去対象の範囲を決めてあげる必要がありますね。
（感覚的な判断で決めている場合は、マクロで処理するのは難しい場合もあります）

fujillin · Answer

こんにちは

「シート７」は特別な意味を持つシート（例えば全体のまとめのシートとか）ではなく、他のシートと同じ構成のシートと解釈して良く、たまたまマクロの記録をこのシート上で行ったと考えて良いのですよね？

・・・であるとすれば、シートを特定している『ActiveWorkbook.Worksheets("7")』を全部『ActiveSheet』に置き換えてあげればよさそうに思います。

※ シート指定のある範囲指定と、シート指定の無い範囲指定が混在する形となっているので若干気持ち悪いですが、指定がないものはActiveSheetが対象と解釈されますので、とりあえずは、上記の対応だけで動作するものと思います。
※ 複数シートで同じ処理を繰り返すのなら、それこそ対象シートをまとめて処理するマクロにしておくことで（シート毎に同じ処理をループさせる）、それぞれのシートでマクロを実行する必要もなくなりますね。

Excel マクロを各シートごとに実行したい

考えてみました。

#3の回答者です。

こんにちは。

ANo1です。

こんにちは

似たような質問が見つかりました

このQ&Aを見た人はこんなQ&Aも見ています

関連するカテゴリからQ&Aを探す

このQ&Aを見た人がよく見るQ&A

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング