マクロの処理速度を上げたい

質問

例えば"A1"から"Z100"までランダムに数字が入っている場合に、
次の処置をしたいのです。
　処理Ａ：１０以下の数値を０に置き換える。
"A1"から始まるのはほぼ決まっているのですが、
最後のセルが決まっていません。
いろいろなときに使えるように下記マクロを作りましたが、
データ量が多いのか、処理に時間がかかってしまいます。
(本番データは200×3000件くらいあり、処理も例より複雑です)

処理は行えているみたいなので、速度を上げるのにいい方法はないか
相談させてください。

プログラムの知識は基本情報処理試験のC言語を勉強していた
くらいです。マクロは本を見ながら作っているので、調べきれて
いない部分もあるかもしれませんが、よろしくお願いいたします。

参考にしている本は、C&R研究所のEXCEL VBAハンドブックです。

＝＝＝＝ここから＝＝＝＝
sub テスト()
'使用する変数
　dim LastColNum as integer
　dim i as integer

　'Ａ１をアクティブにします
　range("A1").select
　'最後の列の行番号を調べます
　LastColNum=range("A1").end(xlToRight).column

　'アクティブなセルが空白になるまで処理を続けます
　Do Until activecell.value=""

　　'行数分処理を続けます
　　for i=0 to LastColNum-1
　　　'10未満だったら処理をします
　　　if activecell.offset(0,i).value<10 then
　　　　'１０未満のセルに０を入力します。
　　　　activecell.offset(0.i).value=0
　　　end if
　　next
　　'次の行をアクティブにします
　　activecell.offset(1,0).activate
　Loop
end

回答No.7

Wendy02

こんにちは。

あまり、特定の人をひいきにしたりしてはいけないかもしれませんが、#2 のKenKen_SP さんの入れ出しで2次元配列を使ったものは、文句のつけようがありませんね（^^;。(ボタンを押しました。）KenKen_SPさん以上のものを考えるとなると、ちょっと厳しいです。

私も通常は、同じ方法は使いますが、私の場合は、いろいろ考えすぎてしまいます。

60万のデータですから、VBAとはいいながら、まったく次元の違う世界の話です。簡単にみえて、これは、なかなかできません。

#6のmisatoannaさんの紹介されている OfficeTanakaさんのサイトは、有名で、最近では、そこで書かれている話が常識にもなってきていますが、Select が問題だということよりも、Rangeオブジェクトを選んでアクセスするということに自体に、時間のロスがあります。また、Rangeオブジェクトのプロパティを書かずに、EXCEL側にキャストしてもらうという方法も、時間のロスになりますね。

私は、大量データでなかったら、Selectを入れようが、Selection を使おうが、あまり細かく言う必要はないと思っています。記録マクロを手直しして、Selectをなくしてみたところで、あまり大勢に影響を与えるわけではありません。

ためしに、他の方法で、作ってみましたが、以下のコードは25秒で、KenKen_SPさんのは、11秒でした。どうも、それぞれの列やCriteriaにアクセスするロスが遅くする原因でしょうね。（悔しいです! )

計測; APIのtimeGetTime　/データ;1～30のランダム/範囲; A1:GR3000 まで

Sub CeckData2Zero()
　Dim myCrng As Range
　Dim myCriteria As Range
　Dim i As Long
　Const myCondition As String = "<10"
　Application.ScreenUpdating = False
　Range("A1").EntireRow.Insert Shift:=xlDown
　Range("A1", Range("A2").End(xlToRight).Offset(-1)).Formula = _
　"=""FC"" & COLUMN()"
　Set myCrng = Range("A1").CurrentRegion
　Range(myCrng.Cells(myCrng.Rows.Count + 1, 1), "A65536").ClearContents
　With Range("A65536").End(xlUp).Offset(2)
　　.Offset(1).Value = myCondition
　　Set myCriteria = .Resize(2)
　End With
　For i = 1 To myCrng.Columns.Count
　　myCriteria.Cells(1, 1).Value = "FC" & i
　　With myCrng.Columns(i)
　　　.AdvancedFilter _
　　　Action:=xlFilterInPlace, _
　　　CriteriaRange:=myCriteria, _
　　　Unique:=False
　　　.Value = 0
　　　ActiveSheet.ShowAllData
　　End With
　Next
　myCriteria.ClearContents
　Range("A1").EntireRow.Delete Shift:=xlUp
　Application.ScreenUpdating = True
　Set myCrng = Nothing
End Sub

お礼

皆さん、いろいろとプログラムが出てきてすごいです。
もっと勉強して、早く脱初心者したいです。

ありがとうございました。