[[20210602081746]]　『マクロコードの改善』（あああ）　ページの最後に飛ぶ

『マクロコードの改善』（あああ）

いつも大変お世話になっております。

マクロ起動から完了までに時間がかかってしまいます。
自分で修正を行ってはいるのですが、マクロ初心者の自分では改善ができませんでした。

何が問題なのかも見つけることができないため、解決方法を教えて頂きたいです。

以下コード

Sub abc()
Dim cl As Range

Application.EnableEvents = False
Application.ScreenUpdating = False

For Each cl In Range("C3:AG100,AI2:AP90,AS3:AS100")

    cl = ""
Next

Dim cl1 As Range
Dim i1

ActiveSheet.UsedRange.Select
Selection.Borders.LineStyle = True

For Each cl1 In Range("C2:AG2")

    If cl1 = DateSerial(Cells(1, 1), Cells(2, 1) + 1, 1) Then
        cl1.Offset(-1, 0).Borders(xlEdgeLeft).LineStyle = xlDouble
        For i1 = 1 To 100
            If Cells(i1, 1) <> "" Then
                cl1.Rows(i1).Borders(xlEdgeLeft).LineStyle = xlDouble
            ElseIf Cells(i1, 1) = "" Then
                Exit For
            End If
        Next
        Exit For
    End If
Next

Dim cl2 As Range

Columns("AE:AG").Hidden = False

For Each cl2 In Range("AE2:AG2")

    If cl2 = "" Then
        cl2.EntireColumn.Hidden = True
     End If
Next

Dim rg As Range
Dim nm As Range
Dim i2

ActiveSheet.UsedRange.Interior.ColorIndex = xlNone

For Each rg In Range("C1:AG1")

    If rg <> "" Then
        If Weekday(rg) = 7 Then
            rg.Rows("1:2").Interior.ColorIndex = 3
            For i2 = 3 To 100
                If Cells(i2, 1) <> "" Then
                    rg.Rows(i2).Interior.ColorIndex = 3
                ElseIf Cells(i2, 1) = "" Then
                    Exit For
                End If
            Next

        ElseIf Weekday(rg) = 1 Then
            rg.Rows("1:2").Interior.ColorIndex = 3
            For i2 = 3 To 100
                If Cells(i2, 1) <> "" Then
                    rg.Rows(i2).Interior.ColorIndex = 3
                ElseIf Cells(i2, 1) = "" Then
                    Exit For
                End If
            Next

        End If
    ElseIf rg = "" Then
        Exit For
    End If
Next

Range("A1").Select

Application.ScreenUpdating = True
Application.EnableEvents = ture
End Sub

お手数をおかけしますが、よろしくお願いいたします。

＜使用 Excel：Excel2019、使用 OS：Windows10 ＞

１セルずつ書き換えるのではなくforを抜けたセルまでを範囲指定して一度に操作するといいです
（砂糖） 2021/06/02(水) 08:51

スマホで見てるのでパッと見だけですが。

１、ループ処理の必要がない

 For Each cl In Range("C3:AG100,AI2:AP90,AS3:AS100")
    cl = ""
 Next

２、いちいち選択する必要がない

 ActiveSheet.UsedRange.Select
 Selection.Borders.LineStyle = True

３、ElseIfである必要がない

 If Cells(i1, 1) <> "" Then
     cl1.Rows(i1).Borders(xlEdgeLeft).LineStyle = xlDouble
 ElseIf Cells(i1, 1) = "" Then
     Exit For
 End If

 If rg <> "" Then
    '省略
 ElseIf rg = "" Then
    Exit For
 End If

４、動くかもしれないが、記述がちょっと変

 rg.Rows("1:2").Interior.ColorIndex = 3

などが気になりました。
必要に応じ改修したうえでステップ実行して処理に時間がかかっている部分（無駄な処理）を洗い出してみてはいかがでしょうか？

（もこな２） 2021/06/02(水) 08:54

皆様、ご返答ありがとうございます。

アドバイスを頂いた内容で改善を行っていきたいのですが
何が何だかわからず

サルでも分かるようにご教授いただいてもよろしいでしょうか

ご迷惑をおかけします。
（あああ） 2021/06/02(水) 09:06

例
＞For Each cl In Range("C3:AG100,AI2:AP90,AS3:AS100")
＞ cl = ""
＞Next
は
Range("C3:AG100,AI2:AP90,AS3:AS100") = ""
でいい

元のコードだと１セルずつ空白にしていってますけどものすごい処理に時間かかります
範囲が決まっているなら範囲を指定して一度に書き換えましょう

＞For i1 = 1 To 100
＞ If Cells(i1, 1) <> "" Then
＞ cl1.Rows(i1).Borders(xlEdgeLeft).LineStyle = xlDouble
＞ ElseIf Cells(i1, 1) = "" Then
＞ Exit For
＞ End If
＞Next
ここも空白だったらForから抜けるだけですけど
Forから抜けたときのi1から一つ手前までを範囲選択すれば一度に書き換えられます

あとは見てないですけどForNextのコードに無駄が多いんじゃないでしょうか
（砂糖） 2021/06/02(水) 09:34

Sub test()

    Dim rng1 As Range   '日付欄
    Dim rng2 As Range   '内容欄
    Dim rng3 As Range   '集計欄
    Dim rng4 As Range   '判定欄
    Dim ix As Long      '表示列数

    'セル範囲の定義等
    Set rng2 = ActiveSheet.Range("C3:AG100")
    Set rng1 = .Offset(-2).Resize(2)
    Set rng3 = rng2.Offset(-1, .rng2.Columns.Count + 2).Resize(91, 2)
    Set rng4 = rng2.Columns(40)
    ix = Day(DateSerial(yare(rng1(1).Value), Month(rng1(1).Value + 1), 1) - 1)

    '初期化
    Union(rng2, rng3, rng4).ClearContents   '値のクリア
    With rng2
        .Borders.LineStyle = True           '罫線を細線に
        .EntireColumn.Hidden = True         '列全体を非表示に
        With .Resize(, ix)
            .EntireColumn.Hidden = False    '必要列分を表示
            .Borders(xlEdgeLeft).LineStyle = xlDouble   '右側を２重線に
        End With
    End With
End Sub

こんな感じで個々のセルではなく、
セル範囲に対して命令してください。
個々のセルでセルの書式設定をすると、ファイルも大きくなりがちです。
まとめられるところはまとめましょう。

まずはセル範囲の表現方法を学ぶとよいかと。
（まっつわん） 2021/06/02(水) 11:59

ご回答いただいた皆様、ご丁寧にお答えいただき本当にありがとうございました。

大変分かりやすく、改善点、勉強すべき内容が見えました。

本当にありがとうございました。
（あああ） 2021/06/02(水) 13:59

コメント返信：

[ 一覧(最新更新順) ]

[[20210602081746]] 『マクロコードの改善』（あああ） ページの最後に飛ぶ

[[20210602081746]]　『マクロコードの改善』（あああ）　ページの最後に飛ぶ