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

マクロ初心者です。

エクセルブックでシフトの管理をしています。
一日分の各ワークシートごとに必要な作業をしてから
同じ部分を、並べ替えして不要な部分を削除したいのです

以下はシート７で、作業をして記録したマクロです。
これを各アクティブシートごとに同じマクロで実行したいのですが
うまく書き換えできませんでした。
どのように変更すればいいのか、教えてください。
よろしくお願いします。
-------------------------------------------------------
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

No.5 ベストアンサー 回答者： WindFaller 回答日時： 2016/05/14 19:42

考えてみました。

画面をみないと、想像が付かないものがあるものですね。

質問にあるマクロをみると、
最初あった、　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

この回答へのお礼

きれいに並べ替えと、削除ができました！理想通りです。
すこしずつですが、理解できるよう学習していきます。
1点だけ、35行目のタイトル行がマクロ後消えてしまったので、後半の("35:" & Lr)を("36:" & Lr)に変更したら、うまくいきました。

お手数おかけしてしまいましたが、本当に助かりました。
ありがとうございました！！

お礼日時：2016/05/14 22:37

No.4 回答者： WindFaller 回答日時： 2016/05/13 15:03

#3の回答者です。

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

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

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

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

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

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

この回答へのお礼

すみません。かえってお手数をかけてしまいました。
私も調べてみます。ありがとうございます。

お礼日時：2016/05/13 22:51

No.3 回答者： WindFaller 回答日時： 2016/05/12 15:13

こんにちは。

私は、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

この回答へのお礼

詳細なコードを作っていただきありがとうございました！
お返事おそくなり申し訳ありません。
読み理解するのに時間がかかってしまいました。

いただいたコードで試してみたところ、
私のファイルに問題があるために、実行時エラーが出てしまいました。
質問してもいいでしょうか？

最初に　実行時エラー　1004＞この操作には同じサイズのセルが必要です
35行と78行に結合セルがあるため、並べ替えの範囲を36行から77行まで、列は1から15の範囲で設定したいのですが
（全シート同じ位置です）
Ln = 36,77
Cl = 15　という表記でいいのでしょうか？

また、後半のフィルター削除部分
実行時エラー424 オブジェクトが必要です。
デバックを押すと　以下の行がハイライトされます。
With Rng.Resize(, 118)　　'拡張　DN列まで
最初の私のコードには、ActiveSheet.Range("$A$35:$DN$78")とありますが
実際のシートのデータは　Ａ35　～　ＣＣ77までで　（,81）
35行はタイトル行です。
118列までデータが入ってないから？ということなのでしょうか？？？

使用しているのはエクセル2010　です。
よろしくお願いします。

お礼日時：2016/05/13 02:21

No.2 回答者： fujillin 回答日時： 2016/05/12 09:31

ANo1です。

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

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

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

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


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

この回答へのお礼

ありがとうございます！
ご指摘の通り、消去の範囲指定がこのソースでは、Ｓｈｅｅｔ７での消去範囲になっていますので違ってしまっているようです。

やりたかったのは、$A$35:$DN$78の範囲でフィルターをかけて、0：00と*(*)*を含む行を削除したかったわけです。
（当日シフトに入ってない人の行を削除）
シートにより、該当する行が違ってしまうのでうまくいかないようです。
もう少し勉強してみます！

お礼日時：2016/05/12 10:44

No.1 回答者： fujillin 回答日時： 2016/05/11 16:41

こんにちは

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

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


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

この回答へのお礼

早速の回答ありがとうございます！
ご指摘の通り、5ヶ所をActiveSheetに置き換えて、無事に並べ替えできるようになりました。スッキリです！
ただ後半のフィルター削除が、うまく動作せずに、不要な行が少しづつ残ってしまいます。なにか解決策ありますでしょうか？

お礼日時：2016/05/11 19:15