【マクロ】全シートでまとめて実行するには？

質問

教えてください。マクロは初心者です。
↑先ほど、http://oshiete1.goo.ne.jp/qa5695407.html
で、ある親切な方に以下のマクロを教えて頂きましたが、私がその時にまとめて聞くのを忘れてしまい、改めて教えていただきたく思います。
------------------------------------------------
Sub test()
　Dim R As Long
　For R = 1 To Cells(Rows.Count, "B").End(xlUp).Row
　　　If Cells(R, "B").Value = "土" Or CellsR, "B").Value "日" Then
　　　　　Cells(R, "A").Resize(1, 5).Interior.ColorIndex = 6
　　　End If
　Next R
End Sub
----------------------------------------------------

上記のマクロを１シートでなく、全シートでまとめて実行したいのですが（どのシートも同様の内容なので）、どうすればいいのかわかりません。
どの個所にどんなコードを入れればよいのでしょうか？
よろしくお願いします。
【XP、2003】

回答No.6

myRange · ベストアンサー

前回回答した、myRnageです。

既出の回答にあるようにエラーが出たら、
エラーのメッセージとエラーの出たコードを提示しないと
的確なアドバイスをしようがありません。

質問者用？の下記コードを実行してみてください。
エラーが出たら、どのシートのどのセルかが表示され、ストップします。

'------------------------------
Sub test()
Dim R As Long
Dim S As Long
On Error GoTo ErrDesu
For S = 1 To Sheets.Count
　For R = 1 To Sheets(S).Cells(Rows.Count, "B").End(xlUp).Row
　　If Sheets(S).Cells(R, "B").Value = "土" Then
　　　　Sheets(S).Cells(R, "B").Font.ColorIndex = 5
　　　　Sheets(S).Cells(R, "A").Resize(1, 5).Interior.ColorIndex = 6
　　End If
　　If Sheets(S).Cells(R, "B").Value = "日" Then
　　　　Sheets(S).Cells(R, "B").Font.ColorIndex = 3
　　　　Sheets(S).Cells(R, "A").Resize(1, 5).Interior.ColorIndex = 6
　　End If
　Next R
Next S
Exit Sub
ErrDesu:
　MsgBox "エラーは、シート：" & Sheets(S).Name & "　のセル：Ｂ" & R & " です"
End Sub
'-----------------------
以上です。

お礼

myRangeさん

たびたびお助け頂き、ありがとうございます。
私の知識不足ゆえに皆様にかえって御迷惑をかけてしまいました。
何度も見直すことで、無事解決できました。

本当に感謝しています。
ありがとうございます。

回答No.5

chibita_papa

＞『型が違います』とエラーが出てしまいます。
おそらく、Ａ列に #N/A が有りませんか。

別解ですが
VBEエディターのThisWorkbookのシートに
Private Sub Workbook_SheetChange(ByVal sh As Object, ByVal Target As Range)
Dim R As Long

If Target.Column >= 3 Then Exit Sub

For R = 1 To Cells(Rows.Count, "B").End(xlUp).Row
If Cells(R, "B").Value = "土" Or Cells(R, "B").Value = "日" Then
Cells(R, "A").Resize(1, 5).Interior.ColorIndex = 6
　　　else
Cells(R, "A").Resize(1, 5).Interior.ColorIndex = xlNone
End If
Next R
End Sub

とすれば、データを入力する都度色が変わります。

またまた、別解ですが
これは、ＶＢＡで作るより条件付き書式で対応すべきだと
思いますが
条件付き書式をご存じなかったら調べるか、再度質問してください。

補足

chibita_papaさん、ありがとうございます。
条件付き書式はすでに３つとも使っている状態だったので
マクロにしました。

色々な方法があるのだと、勉強になり
たすかりました。本当にありがとうございました。

回答No.4

hige_082

＞『型が違います』とエラーが出てしまいます。
どこで？
サンプルデータで試しましたがエラー出ませんが？
エラー時、デバッグボタンでエラー個所が黄色で表示される
そのコードが分らないと原因が分からない

'色を付けるセルがずれている所があったので修正しました
Sub test1()
Dim S As Range
Dim sh As Worksheet
For Each sh In Worksheets
For Each S In sh.Range("B1:b" & sh.Range("A" & Rows.Count).End(xlUp).Row)
Select Case S.Value
Case "土"
S.Font.ColorIndex = 33
S.Offset(, -1).Resize(1, 5).Interior.ColorIndex = 6
Case "日"
S.Font.ColorIndex = 3
S.Offset(, -1).Resize(1, 5).Interior.ColorIndex = 6
End Select
Next S
Next sh
End Sub

お礼

そうですね。
どこでエラーを出すべきでした。
何度もすみません。
なんどかやりなおしをしてみたところ
思った形になりました。
いろいろ触りすぎて何か間違っていたようです。
本当に何度もすみませんでした。

回答No.3

hige_082

最初からコードを提示してくださいね
withが理解できていないようなので
取ってみました

Sub test1()
Dim S As Range
Dim sh As Worksheet
For Each sh In Worksheets
For Each S In sh.Range("B1", sh.Range("A" & Rows.Count).End(xlUp))
Select Case S.Value
Case "土"
S.Font.ColorIndex = 33
S.Resize(1, 5).Interior.ColorIndex = 6
Case "日"
S.Font.ColorIndex = 3
S.Resize(1, 5).Interior.ColorIndex = 6
End Select
Next S
Next sh
End Sub

'withを使用すると
Sub test2()
Dim S As Range
Dim sh As Worksheet
For Each sh In Worksheets
With sh
For Each S In .Range("B1", .Range("A" & Rows.Count).End(xlUp))
With S
Select Case .Value
Case "土"
.Font.ColorIndex = 33
.Resize(1, 5).Interior.ColorIndex = 6
Case "日"
.Font.ColorIndex = 3
.Resize(1, 5).Interior.ColorIndex = 6
End Select
End With
Next
End With
Next
End Sub

もう少しスキルを上げてからの方がよいと思いますよ
参考まで

補足

hige_082さん
本当にいろいろとありがとうございます。
未熟なことは十分承知で質問させていただきました。

作っていただいたコードで早速試してみたのですが
『型が違います』とエラーが出てしまいます。

もしよろしければ、対処法をお教えください。
どうかよろしくお願いします。

回答No.2

okormazd

「土」を青、「日」を赤にして、黄色で塗りつぶすのね。
with　sh
が効いていない。

For Each S In .Range("B1", .Range("A" & Rows.Count).End(xlUp))
・
・
・
For R = 1 To .Cells(Rows.Count, "B").End(xlUp).Row
If .Cells(R, "B").Value = "土" Or .Cells(R, "B").Value = "日"　then

Rangeの前、Cellsの前に「.」をつけなければダメだね。
もう少し自分で考え、勉強しないと・・・。

お礼

okormazdさん

仰る通りで勉強不足です。
もっとしっかり知識を入れてから、質問すべきところを
順序が逆になってしまいました。
本当にすみません。
いろいろ教えていただきありがとうございました。

回答No.1

okormazd

下記のようなものでどうでしょう。

Sub test()
Dim R As Long
For Each sh In Worksheets
With sh
For R = 1 To .Cells(Rows.Count, "B").End(xlUp).Row
If .Cells(R, "B").Value = "土" Or .Cells(R, "B").Value = "日" Then
.Cells(R, "A").Resize(1, 5).Interior.ColorIndex = 6
End If
Next R
End With
Next
End Sub

補足

okormazdさん、御親切にありがとうございます。
早速試してみたのですが、私がきちんと理解できていないため
うまくできません。（一つのシートしか動きません）
-----------------------------------------------------------
Sub test()
Dim S As Range
For Each sh In Worksheets
With sh
For Each S In Range("B1", Range("A" & Rows.Count).End(xlUp))
With S.Range("A1")
Select Case S.Value
Case "土"
.Font.ColorIndex = 33 '
Case "日"
.Font.ColorIndex = 3
End Select
End With
Next
Dim R As Long
For R = 1 To Cells(Rows.Count, "B").End(xlUp).Row
If Cells(R, "B").Value = "土" Or Cells(R, "B").Value = "日" Then
Cells(R, "A").Resize(1, 5).Interior.ColorIndex = 6
End If
Next R
End With
Next
End Sub
----------------------------------------------------------
土日の色をそれぞれ青と赤に変えて、かつ土日の場合は
A列からE列までを黄色にするというマクロを作りたかったのですが…
色々試して触っているので、文法的に変なところもあると思います。
初心者のためお許しください。
もしよろしければ引き続きご教授ください。