VBA Matc関数

以下は、他ブックのセルのデータを300個　配列HAiretuに入れて、Match関数を使ってHairetuの中に指定された文字(変数targetの中身)があるかどうか調べています。
あればTrueを、無ければFalseを返します。これを多くて170回繰り返すのですが、処理が重たいのか途中でフリーズ？してしまいます。

ファイルを開かないExecuteExcel4Macroを使えば、処理速度は早くなるという認識で使ったのですが、どこが原因で途中で止まってしまうのでしょうか。

####現在のコード

Function tes(target, Filename) As Boolean
path = Sheet_path(c)

Dim Hairetu(1 To 300) As Variant

For i = 1 To 300
Hairetu(i) = ExecuteExcel4Macro("'" & path & "[" & Filename & "]シート'!R" & i & "C81")
Next i

On Error Resume Next
num = Application.WorksheetFunction.Match(target, Hairetu, 0)
On Error GoTo 0

If num = 0 Then
   tes = False

Else
   tes = True
End If

End Function

######試したこと
Matchは配列の検索に向かないと仮説をたて、セルに書き出してから検索させましたが、変わりませんでした。

For i = 1 to 300
Cells(i,21) = ExecuteExcel4Macro("'" & path & "[" & Filename & "]シート'!R" & i & "C81")
Next i

On Error Resume Next
num = Application.WorksheetFunction.Match(target, Range("U1:U300"), 0)
On Error GoTo 0

meg_

2020/08/21 11:22

> 処理が重たいのか途中でフリーズ？してしまいます。 Excelマクロは少し時間がかかるものを実行するとフリーズしたように見えることがあります。待てばだいたいは実行完了すると思います。 > ファイルを開かないExecuteExcel4Macroを使えば、処理速度は早くなる普通にファイルを開くのとどちらが速いかはファイルサイズや処理内容によるかと思います。両方試して速い方を採用してはどうでしょうか？

yureighost

2020/08/21 11:38 編集

重い一番の理由はセルをループで一つ一つ配列に入れてるからだと思いますよ。 ExecuteExcel4Macroでできるのかはやったことないですが、少なくとも開いたブックならRangeで300セル分範囲選択して一回の動作で配列に格納することが可能です。そもそもMatchは配列に対して行うと遅いです。ブック開いてRangeを対象とした方が高速なのですがそれだとまずいのでしょうか。

行動規範の内容に同意します

回答2件

ベストアンサー

ExecuteExcel4Macroで値を1個取ってくるのに0.3秒だとして
（どこかのサイトでそんな感じで書いてあったけど意外と重い）、
300個で90秒かかり（単純に掛け算になる）ますが、
ファイルを開く場合はファイルを開くまでの時間が大半（重くて10秒？20秒？）で、
開いてしまえば参照はそれほど時間がかかりません。
なので、ファイルを開く時間との比較になりますね。
で、これをまた何回も繰り返すんですよね？

ファイルを開かない方法としては、数式で参照する方法もありますが、
そちらは試されましたか？

1つのファイルが300セル分なら、検索する値が10万個とかにはならないかなと思います。
全てを1回変数なりシート上なりに全部まとめてから、検索してみては？

以下サンプルコード（※概略のイメージです）

ExcelVBA
1Option Explicit
2
3Dim mFSO As FileSystemObject
4
5Sub test()
6    Dim sPath As String
7    Dim sFiles As Variant
8    Dim v As Variant
9    Dim c As Range
10    
11    Set mFSO = New FileSystemObject
12    Application.ScreenUpdating = False
13    
14    'フォルダーのパス指定
15    sPath = GetPath()
16    '対象ファイルのフルパスのリスト作成
17    sFiles = GetFiles(sPath)
18    '対象ファイルの値をリスト化
19    v = GetList(oFiles)
20    'リストをシート上に転記
21    Set c = Range("F1").Resize(UBound(v))
22    c.Value = WorksheetFunction.Transpose(v)
23    
24    '各値の存在確認
25    With Range("A1:A100").Offset(, 1)
26        .Formula = "=If(Countif(" & c.Address & ",A1),True,False)"
27        .Value = .Value
28    Next
29    
30    'リストの消去
31    c.ClearContents
32End Sub
33
34'複数ファイルの値を一次配列へリスト化
35Private Function GetList(ByRef vv As Variant) As Variant
36    Dim v As Variant
37    Dim r() As Variant
38    Dim i As Long, j As Long, k As Variant
39    Dim wb As Workbook
40    
41    ReDim r(1 To 100000)
42    For Each v In vv
43        Set wb = Workbooks.Open(v)
44        k = WorksheetFunction.Transpose(wb.Worksheets(1).Range("U1:U300"))
45        wb.Close False
46
47        For j = 1 To 300
48            i = i + 1
49            r(i) = k(j)
50        Next
51    Next
52    
53    ReDim Preserve r(i To i)
54    GetList = r
55End Function