[[20220110164859]] 『複数シートをマクロにて処理したい』(こはのり) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『複数シートをマクロにて処理したい』(こはのり)

色々なマクロを組み合わせて作業しておりますが、
命令をどこに挿入したらいいかわからないためご教示いただきたく。
何卒宜しくお願い致します。

内容: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


>「ifブロックに対応するEnd ifがありません。」

「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


ピンクさま 
失礼いたしました。
当初の目的は達成できました。
ご丁寧にありがとうございます。
(こはのり) 2022/01/11(火) 18:22

コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.