VBAの処理が止まる原因と対策を知りたい 削除
Message#1 2015年2月10日(火)22時12分 From: vbaとまる |
現在以下のとおりのVBAを動かしいますが、途中でフリーズしてしまうため、 原因が特定できずに困っています。 その原因と対策もしくは、原因を突き止める方法をご教授いただければと思います。 ・サーバ上にあるブックを4つ開く(BookA、BookB、BookC、BookD) ・BookAに記載している文字列を配列に入れる ・BookB上にて、前述の文字列を検索し、そのアドレスを取得(後述の関数B) ・BookB上にて、前述のアドレスから別の文字列を取得(後述の関数A) となります。なお「Application.ScreenUpdatingの停止」と「Application.Calculationを手動」は実施しましたが、改善しませんでした。 以下環境、状況、VBAの記述になります。 環境 OS:Windows7 64bit CPU:i3 メモリ:8GB EXCEL:2010 状況 ・関数Aから関数Bを呼んだ後にフリーズしている模様です(関数Bを呼ぶところまでは、確認できますが、その後フリーズをするため、関数Aに戻っているかは不明です)。 ・フリーズ時のEXCEL.EXEのCPU使用率は25%で固定です。 関数A Function Test1(WS1 As Worksheet, Str1() As String, Str2() As String) Dim i As Integer Dim Row As Integer, Co As Integer Dim Temp_Range As Range Dim Temp_Str As String For i = 1 To UBound(Str2) ReDim Preserve Str1(i) Temp_Str = Test2(WS1, Str2(i - 1)) If Temp_Str <> "ない" And Temp_Str <> "重複" Then Set Temp_Range = WS1.Range(Temp_Str) If Temp_Range.MergeCells Then Co = Temp_Range.Column + Temp_Range.MergeArea.Count - 1 Else Co = Temp_Range.Column End If Row = Temp_Range.Row Str1(i - 1) = WS1.Cells(Row, Co).Offset(0, 1).Value End If Next i End Function 関数B Function Test2(WS1 As Worksheet, Str1 As String) As String Dim temp As Range Dim a, b As Boolean Dim r As String Dim i, j As Integer Set temp = WS1.UsedRange For i = 1 To temp.Rows(temp.Rows.Count).Row For j = 1 To temp.Columns(temp.Columns.Count).Column If Replace(WS1.Cells(i, j).Value, vbLf, "") = Replace(Str1, vbLf, "") Then If a = False Then r = WS1.Cells(i, j).Address a = True Else r = "重複" b = True Exit For End If End If Next If b = True Then Exit For Next If r = "" Then r = "ない" Test2 = r End Function |
上のメッセージを削除します。
よければパスワードを入力し、削除ボタンをクリックしてください。