[[20190731144159]]　『0.1以下を０に』（初心者）　ページの最後に飛ぶ

『0.1以下を０に』（初心者）

VBA初心者です。
処理にすごく時間がかかるので原因を教えていただきたい。
２０分位かかってしまいます。

下のようなマクロを作りました。

もしC列とG列とE列とI列に0.1以下の数字があった場合
０に変化するというマクロ。
しかもデータが入力されていないところまで０が入ってしまいます。

Sub Macro1()

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

    Dim r As Range
     For Each r In Union(Range("A:A"), Range("D:D"), Range("G:G"), Range("I:I"))
           If r.Value < 0.1 Then r.Value = 0
          '    Next

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

End Sub

＜使用 Excel：Excel2007、使用 OS：unknown ＞

とりあえず、C列とG列とE列とI列なのか
A列とD列とG列とI列なのか気になるとこです

Excel2007ならば最大行数=1,048,576行だそうなので
A列に対して1,048,576行処理しているから時間がかかるのかな

詳しいことはわかんないですが、各列の値が入っている最終行までの
処理にすればよいかと
（えく） 2019/07/31(水) 15:01

時間がかかることは、おいといて

＞ If r.Value < 0.1 Then r.Value = 0

ここを　こうしてみては？

If r.Value > 0 And r.Value < 0.1 Then r.Value = 0

（渡辺ひかる） 2019/07/31(水) 15:09

 for each r in intersect(activesheet.usedrange,range("a:a,d:d,g:g,i:i"))
でかわりませんか？
（seiya） 2019/07/31(水) 15:18

＞２０分位かかってしまいます。
さすがに時間がかかりすぎですね。
さしあたって根本的な原因ではないようにおもいますけど、提示されたコードに関して言えば、私も何らかの方法で処理対象範囲を限定すべきだと思います。

さらに、画面更新の抑制と再計算を手動にされてますが、それでも値の書き換えを逐一やっていると時間がかかるようにおもうので、条件に合致するセルは全部0にしてしまえばよいのですから、チェック中はセルを覚えておくのにとどめて、チェックし終わってから一気に0にするほうが良いと思います。

 *---------------------------------------------------------------*
    Sub サンプル壱()
        Dim MyRNG As Range, tmp As Range
        Dim buf As Variant

        For Each buf In Array("A", "D", "G", "I")
            For Each tmp In Range(Cells(1, buf), Cells(Rows.Count, buf).End(xlUp))
                If WorksheetFunction.IsNumber(tmp.Value) And tmp.Value < 0.1 Then
                    If MyRNG Is Nothing Then
                        Set MyRNG = tmp
                    Else
                        Set MyRNG = Union(MyRNG, tmp)
                    End If
                End If
            Next tmp
        Next buf

        If Not MyRNG Is Nothing Then MyRNG.Value = 0

    End Sub
 *---------------------------------------------------------------*
    Sub サンプル弐()
        Dim tmp As Range, buf As Range, MyRNG As Range

        On Error Resume Next
        Set tmp = Range("A1,D1,G1,I1").EntireColumn.SpecialCells(xlCellTypeConstants, xlNumbers)
        On Error GoTo 0

        If tmp Is Nothing Then Exit Sub

        For Each buf In tmp

            If buf.Value < 0.1 Then
                If MyRNG Is Nothing Then
                    Set MyRNG = tmp
                Else
                    Set MyRNG = Union(MyRNG, tmp)
                End If
            End If
        Next buf

        If Not MyRNG Is Nothing Then MyRNG.Value = 0

    End Sub
 *---------------------------------------------------------------*

時間がかかるほうは、
　Application.Calculation = xlCalculationManual
しても改善していないってことは、changeイベントの処理をしているとかないですか？
その場合
　Application.EnableEvents = False
でイベントの発生を抑制するという手はあるとおもいます。

（もこな２） 2019/08/01(木) 06:57

みなさん
ありがとうございます。

もこな２さんのマクロに変更したら数秒で終わりました。

ありがとうございます。

（初心者） 2019/08/01(木) 09:24

コメント返信：

[ 一覧(最新更新順) ]

[[20190731144159]] 『0.1以下を０に』（初心者） ページの最後に飛ぶ

[[20190731144159]]　『0.1以下を０に』（初心者）　ページの最後に飛ぶ