ExcelVBAのFind関数について質問です。

Find関数を使用して検索を行う際に、検索対象のシートに"ヶ月"、"ヵ月"という文字が記載されていると
処理が遅くなってしまします。
解決方法をご存知の方いらっしゃいますでしょうか？

以下、読みにくいプログラムかもしれませんが、ご教授願います。

Sub ボタン1_Click()

Dim value As String
Dim pass As String
Dim template As Workbook
Dim object As Object

'検索対象文字
value = "A"
'テンプレートのパス
pass = "C:\template.xls"
'テンプレートを開く
Set template = Workbooks.Open(pass)
'テンプレートをコピー
ActiveWorkbook.Sheets.Copy
'テンプレートを閉じる
template.Close saveChanges:=False

With ActiveWorkbook.ActiveSheet.Range(Cells(1, 1), Cells(10000, 256))
'テンプレートにAという文字が存在するかのチェック
Set object = .Find(What:=value, LookAt:=xlPart, SearchOrder:=xlByRows)
Do
'存在しない場合は処理を終了
If object Is Nothing Then
End
'存在する場合はA→Bに置き換える
Else
object = Replace(object, value, "B")
End If

'引き続きSheet2にAという文字が存在するかのチェック
Set object = .Find(What:=value, LookAt:=xlPart, SearchOrder:=xlByRows)
Loop While Not object Is Nothing
End With

End Sub

No.2 回答者： doara_2011 回答日時： 2011/09/22 00:49

#1です。

なかなか回答がつきませんね。
相変わらずFindメソッドが遅くなることについての解決方法ではありませんが、
前回の回答で書き忘れていたことがあったので、性懲りもなく出てきました。

この手のワークシートのセルの値を逐次変更していくマクロの、実行速度を
上げるのによく効く定番のテクニックがあります。
1. プログラムの最初の方で、以下を挿入
　Application.ScreenUpdating = False
　プログラムの終了直前に、以下を挿入
　Application.ScreenUpdating = True
　これを行うと、プログラムが終了するまでの間、画面の更新が抑制されます。

2. プログラムの最初の方で、以下を挿入
Application.Calculation = xlCalculationManual
　プログラムの終了直前に、以下を挿入
Application.Calculation = xlCalculationAutomatic
　現在のマクロは、一つのセルの値を変更する度に自動的に再計算を実行しますので、
　特にセルに計算式が書かれているセルがたくさんある場合にはよく効きます。

以上。

No.1 回答者： doara_2011 回答日時： 2011/09/19 23:02

処理が遅くなることについては答えを持ち合わせていないので、最初に

あやまっておきます。

いくつか突っ込みどころのあるプログラムなので、出てきました。
＞Dim object As Object
普通は変数名と変数の型は同じにしません。
あと、Findメソッドの返す変数はRangeオブジェクトなので、ここは
Dim rng as Range
などとすべきでしょう。

＞With ActiveWorkbook.ActiveSheet.Range(Cells(1, 1), Cells(10000, 256))
処理時間を気にされるなら、もっと検索範囲を絞るべきでは？　使用されていない
セルも検索範囲に含めてないですか？
With ActiveWorkbook.ActiveSheet.UsedRange

＞'存在しない場合は処理を終了
＞If object Is Nothing Then
＞End
ヘルプによればEndステートメントは「強制的にプログラムを終了させる手段を提供する」
と書かれています。今回の場合は、ukmtさんの思った通りに動くかとは思いますが、
かなり乱暴なやり方と言えます。普通はEndステートメントを使用しなければならない
状態にはなりません。この文脈なら普通は
Exit Do
を書きます。

＞'引き続きSheet2にAという文字が存在するかのチェック
＞Set object = .Find(What:=value, LookAt:=xlPart, SearchOrder:=xlByRows)
同じ文字を前回のFindメソッドと同じ検索条件で検索する場合にはFindNextメソッド
を使用できます。
Set rng = .FindNext(rng)

＞Loop While Not object Is Nothing
ループの終了条件が上記にも、ループの内部にも書かれていて冗長である。
このままなら
＞'存在しない場合は処理を終了
＞If object Is Nothing Then
＞End
の部分はループの一回目だけTrueになる可能性があるだけで、2回目以降は絶対に
Falseになる。
だからループ内のIf ... は最初のFind実行直後に持っていく(つまりループの外。
その場合、前述したExit DoはExit Subに書き換えること)か、
＞Loop While Not object Is Nothing
を
Loop
と書き換える。

総括すると以下の通りになります。

Sub ボタン1_Click()

Dim value As String
Dim pass As String
Dim template As Workbook
Dim rng As Range

'検索対象文字
value = "A"
'テンプレートのパス
pass = "C:\template.xls"
'テンプレートを開く
Set template = Workbooks.Open(pass)
'テンプレートをコピー
ActiveWorkbook.Sheets.Copy
'テンプレートを閉じる
template.Close saveChanges:=False

With ActiveWorkbook.ActiveSheet.UsedRange
'テンプレートにAという文字が存在するかのチェック
Set rng = .Find(What:=value, LookAt:=xlPart, SearchOrder:=xlByRows)
Do
'存在しない場合は処理を終了
If rng Is Nothing Then
Exit Do
'存在する場合はA→Bに置き換える
Else
rng = Replace(rng, value, "B")
End If

'引き続きSheetにAという文字が存在するかのチェック
Set rng = .FindNext(rng)
Loop
End With

End Sub

なお、Do 以下は次のようにも書ける。
'存在しない場合は処理を終了
If rng Is Nothing Then Exit Sub

Do
'存在する場合はA→Bに置き換える
rng = Replace(rng, value, "B")

'引き続きSheetにAという文字が存在するかのチェック
Set rng = .FindNext(rng)
Loop While Not object Is Nothing
End With

End Sub
以上

この回答へのお礼

ありがとうございます。
VBA初心者なもので、知らない事が沢山ありました！
ソースレビュー頂き、かなりソースが見やすくなりました。

ただ、肝心の
>検索対象のシートに"ヶ月"、"ヵ月"という文字が記載されていると
>処理が遅くなってしまします。・・・
の部分の根本的な解決には至っておりません。。。

何か考えられる原因などありますでしょうか？？？

お礼日時：2011/09/20 19:09