[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『複数シートをマクロにて処理したい』(こはのり)
色々なマクロを組み合わせて作業しておりますが、
命令をどこに挿入したらいいかわからないためご教示いただきたく。
何卒宜しくお願い致します。
内容:A1セルに「在庫表」と入っているシートは全部下記の指示を
実行するようにしたいです。
Sub ●月次リセット外部()
'
' 全部リセットする
'
Application.ScreenUpdating = False
Dim maxrow As Long maxrow = Cells(Rows.Count, 12).End(xlUp).Row Dim r As Long For r = 4 To maxrow
If Range("L" & r).Value = "出荷" Then
'↓「出荷」行の色を白にするO列からBB列まで Range(Cells(r, 13), Cells(r, 46)).ClearContents Range(Cells(r, 13), Cells(r, 46)).Interior.Pattern = xlNone
ElseIf Range("L" & r).Value = "入庫" Then
'↓「入庫」行の色を黄色にしてセルをクリアするO列からBB列まで Range(Cells(r, 13), Cells(r, 46)).Interior.Color = RGB(255, 255, 153) Range(Cells(r, 13), Cells(r, 46)).ClearContents
ElseIf Range("L" & r).Value = "在庫" Then
'↓「在庫」行の色を灰色にするO列からBB列まで Range(Cells(r, 13), Cells(r, 46)).Interior.Color = RGB(192, 192, 192)
ElseIf Range("L" & r).Value = "その他" Then
Range(Cells(r, 13), Cells(r, 46)).ClearContents Range(Cells(r, 13), Cells(r, 46)).Interior.Color = RGB(252, 213, 180) End If
Next r
Application.ScreenUpdating = True
Range("A1").Select
MsgBox ("リセットが終了しました")
End Sub
< 使用 Excel:Office365、使用 OS:Windows10 >
>A1セルに「在庫表」と入っているシートは全部下記の指示を >実行するようにしたいです。
参考に Sub ●月次リセット外部() Dim maxrow As Long Dim r As Long, ws As Worksheet Application.ScreenUpdating = False For Each ws In Worksheets If ws.Range("A1").Value = "在庫表" Then maxrow = ws.Cells(Rows.Count, 12).End(xlUp).Row For r = 4 To maxrow If ws.Range("L" & r).Value = "出荷" Then '↓「出荷」行の色を白にするO列からBB列まで ws.Range(ws.Cells(r, 13), ws.Cells(r, 46)).ClearContents ws.Range(ws.Cells(r, 13), ws.Cells(r, 46)).Interior.Pattern = xlNone
(ピンク) 2022/01/10(月) 17:54
恐縮ですが質問2点ございます。
1)追加の処理で、各シートK列でのソートをはずして処理を行った後にK列で
ソートをかけて次のシートで同じ処理を行うということを
したいのですが、命令の挿入部分は下記で正しいでしょうか?
2)下記の命令を実行すると一番下のEnd Subが反転して
「ifブロックに対応するEnd ifがありません。」とエラーが出てしまいます。
どこがまちがっているのでしょうか?
ご教示いただけたら幸いです。
Sub ●月次リセット外部()
Dim maxrow As Long Dim r As Long, ws As Worksheet Application.ScreenUpdating = False For Each ws In Worksheets If ws.Range("A1").Value = "在庫表" Then maxrow = ws.Cells(Rows.Count, 12).End(xlUp).Row For r = 4 To maxrow
追加→ ActiveSheet.Range("$A$4:$BI$703").AutoFilter Field:=11
If Range("L" & r).Value = "出荷" Then
'↓「出荷」行の色を白にするO列からBB列まで Range(Cells(r, 13), Cells(r, 46)).ClearContents Range(Cells(r, 13), Cells(r, 46)).Interior.Pattern = xlNone ElseIf Range("L" & r).Value = "入庫" Then '↓「入庫」行の色を黄色にしてセルをクリアするO列からBB列まで Range(Cells(r, 13), Cells(r, 46)).Interior.Color = RGB(255, 255, 153) Range(Cells(r, 13), Cells(r, 46)).ClearContents ElseIf Range("L" & r).Value = "在庫" Then '↓「在庫」行の色を灰色にするO列からBB列まで Range(Cells(r, 13), Cells(r, 46)).Interior.Color = RGB(192, 192, 192) ElseIf Range("L" & r).Value = "その他" Then Range(Cells(r, 13), Cells(r, 46)).ClearContents Range(Cells(r, 13), Cells(r, 46)).Interior.Color = RGB(252, 213, 180)
追加→ ActiveSheet.Range("$A$4:$BI$703").AutoFilter Field:=11, Criteria1:="●"
End If
Next r
Application.ScreenUpdating = True
Range("A1").Select MsgBox ("リセットが終了しました")
End Sub
(こはのり) 2022/01/11(火) 10:19
「For Each ws In Worksheets」に対応する「Next」がないみたいです。
(わからん) 2022/01/11(火) 11:06
>If ws.Range("A1").Value = "在庫表" Then に対する End If がありません。
(nm) 2022/01/11(火) 11:18
>追加の処理で、各シートK列でのソートをはずして処理を行った後にK列で 当初の目的も出来ていないのに追加処理ですか?
Sub ●月次リセット外部() Dim maxrow As Long Dim r As Long, ws As Worksheet Application.ScreenUpdating = False For Each ws In Worksheets If ws.Range("A1").Value = "在庫表" Then maxrow = ws.Cells(Rows.Count, 12).End(xlUp).Row For r = 4 To maxrow If ws.Range("L" & r).Value = "出荷" Then '↓「出荷」行の色を白にするO列からBB列まで ws.Range(ws.Cells(r, 13), ws.Cells(r, 46)).ClearContents ws.Range(ws.Cells(r, 13), ws.Cells(r, 46)).Interior.Pattern = xlNone ElseIf Range("L" & r).Value = "入庫" Then '↓「入庫」行の色を黄色にしてセルをクリアするO列からBB列まで ws.Range(ws.Cells(r, 13), ws.Cells(r, 46)).Interior.Color = RGB(255, 255, 153) ws.Range(ws.Cells(r, 13), ws.Cells(r, 46)).ClearContents ElseIf Range("L" & r).Value = "在庫" Then '↓「在庫」行の色を灰色にするO列からBB列まで ws.Range(ws.Cells(r, 13), ws.Cells(r, 46)).Interior.Color = RGB(192, 192, 192) ElseIf ws.Range("L" & r).Value = "その他" Then ws.Range(ws.Cells(r, 13), ws.Cells(r, 46)).ClearContents ws.Range(ws.Cells(r, 13), ws.Cells(r, 46)).Interior.Color = RGB(252, 213, 180) End If Next r End If Next Application.ScreenUpdating = True Range("A1").Select MsgBox ("リセットが終了しました") End Sub
(ピンク) 2022/01/11(火) 17:54
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.