VBA while doでファイルを開く

追記依頼:: Function IsContained(target, filename) As Booleanに配列にセルの値を格納するコードを書いています。以下でエラーがでます。
myarray2(1, i) = Workbooks(filename).Worksheets("説明").vbDate(1, i)
参考資料　https://excel-ubara.com/excelvba1/EXCELVBA414.html
http://yumem.cocolog-nifty.com/excelvba/2010/11/post-de50.html
https://officevba.info/cellstoarray/
https://www.moug.net/tech/exvba/0100049.html

170近くの数のファイルを配列Sheetに格納して、配列に入っているファイルを一つづつ取り出します。
取り出したファイルのCC列のセルのデータを取得し、現在開いているAファイルと、取り出したデータを照合し、Aファイルと同じデータがあれば[一致]を、なければ、どんどんファイルを取り出していき、全てのファイルに同じデータがなければ、[不一致]を入力するプログラムを書いています。

現在のコードですと、配列に入っているファイルを全て開くのに、20分ほどかかってしまいます。

過去にも似たような、質問をさせていただきましたが上手く実装できませんでした。
今回はコード全体を載せて質問させていただきます。

あまりコードの形を崩さずに、ファイルを早く開いて処理をする方法はありませんでしょうか？

以下がコードとなります。VBA歴1ヶ月のコードで、お見苦しいかもしれませんが、よろしくお願いいたします。
function関数の2行目にファイルを開く処理を記述しています

グローバル変数 仮で200
Dim Sheet(200) As String 'ファイルのパスとシート名(book.xlsxなど)が合わさったものを格納の配列
Dim Sheet_path(200) 'ファイルのパスだけ配列に格納
Dim b As Long
Dim a As Long
Sub hikaku()

Set this = ThisWorkbook.Worksheets("イベント")



a = 1  
e = 2  
c = 1 
d = 1  


this_line = this.Cells(Rows.Count, 7).End(xlUp).Row 'G列のデータの最終行を取得


Do While this_line > a 'AファイルのG列のデータ分だけループ

     target = this.Cells(e, 7).Value '(AファイルG列のデータを取得)

    Do While UBound(Sheet) > d '配列の要素数分だけ繰り返し

          filename = Sheet(c)  '配列に入っているデータ(比較ファイルのパス)を変数に格納

        '関数呼び出し
        Call IsContained(target, filename)

        If IsContained(target, filename) = True Then    '戻り値がTrueだった場合

           this.Cells(e, 8).Value = "一致"

           Exit Do

        Else
            this.Cells(e, 8).Value = "不一致"

        End If

     d = d + 1
     c = c + 1

     Loop
     d = 1
     c = 2
     b = b + 1
     a = a + 1
 Loop

End Sub
'関数
Function IsContained(target, filename) As Boolean　'関数

path = Sheet_path(b) 'パスだけ変数に代入
'######ここで開く処理
Set open_file = Workbooks.Open(filename:=path & "\" & filename, UpdateLinks:=False)

this_line = Workbooks(filename).Worksheets("説明").Cells(Rows.Count, 81).End(xlUp).Row　`比較ファイルのデータの最終行を取得

i = 1
j = 10


Application.ScreenUpdating = False


Dim s As String

'配列にセルの値を入れる処理
s = ("CC10:" & "CC" & CStr(this_line))
Dim vbDate As Variant
Dim myarray2

vbDate = Range(s)
ReDim myarray2(1, 1 To 200)
For i = LBound(vbDate, 1) To UBound(vbDate, 1)
'ここでエラー
  myarray2(1, i) = Workbooks(filename).Worksheets("説明").vbDate(1, i)
Next i

 Do While this_line / 2 > i 'データ数分だけ繰り返し　セルが結合してあるので2で割る



ThisWorkbook.Activate


       If Workbooks(filename).Worksheets("説明").Cells(j, 81).Value Like target Then      'AファイルG列のデータが、比較ファイルにあれば
          IsContained = True

          Exit Do


      Else

          i = i + 1
          j = j + 2

       End If
    IsContained = False
 Loop
Workbooks(filename).Close


Application.ScreenUpdating = True
End Function

meg_

2020/08/11 14:12

> 現在のコードですと、配列に入っているファイルを全て開くのに、20分ほどかかってしまいます。ファイルを開くのにかかる時間はファイルサイズやマシンスペックに依存するかと思うのですが、その辺りの改善は出来ないのでしょうか？

yakumo02

2020/08/11 14:43

聞いてみましたがエクセルファイルもマシンスペックも、上の方の主導なので、改善できません。

meg_

2020/08/12 11:58

> すみません、どうしてもセルの値を配列に格納することで、つまずいてしまいます。 > 型が一致しないエラーです。何か良い参考資料はありませんでしょうか？コードのどこでエラーが起きているのか書いてください。

meg_

2020/08/12 12:22

> myarray2(1, i) = Workbooks(filename).Worksheets("説明").vbDate(1, i) 上記は「myarray2(1, i) = vbDate(1, i)」で良いのではないですか？ ※vbDateは日付型の定数としてVBAで定義されているので別の変数名にした方が良いかと思います。

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

回答3件

ベストアンサー

まず、ループですべてのセルを比較して一致するか確認してますが、一つずつセルを参照するのは遅いです。
配列に格納してから比較するとか、ワークシート関数でできることならこれが一番速いです。

今回の場合なら、MATCH関数で比較できます。下記のような式になります。

=IF(IFERROR(MATCH(G1,[比較先.xlsx]説明!CC:CC,0),-1)=-1,"不一致","一致")

この式をVBAで設定して、Value で上書きします。

さらに、ブックを開くというのも重い処理ですので、開かずに比較する方法を使いましょう。
その方法は下記の回答で既に紹介しています。

VBA - VBA 大量のファイル｜teratail

上記の回答のリンク先の外部参照を使って、さらに冒頭の式を組み合わせると下記のようなコードで比較できます。

vba
1Sub hikaku1()
2    Const conFormula = "=IF(IFERROR(MATCH(G1,パス[ブック名]説明!CC:CC,0),-1)=-1,""不一致"",""一致"")"
3
4    Dim Path As string
5    Path = "C:\test\"
6    Dim FileName As String
7    FileName = "book.xlsx"
8
9    Dim f As String
10    f = Replace(Replace(conFormula, "パス", Path), "ブック名", FileName)
11    
12    With Range("G1").CurrentRegion.Columns(1).Offset(, 1)
13        .Formula = f
14        .Value = .Value
15    End With
16
17End Sub

とりあえず一つのファイルと比較する場合のコードです。
これができることを確認できたら、ループで複数のファイルと比較するように修正していきましょう。

配列に格納された複数ブックを検索して一致する値があるかチェックする場合のコード例

vba
1Dim Books(200) As String 'ファイルのパスとブック名(book.xlsxなど)が合わさったものを格納
2
3Sub hikaku3()
4Const conFormula = _
5      "=IF(I1=""一致"",""一致"",IF(ISNUMBER(MATCH(G1,{外部参照}説明!CC$1:CC$1000,0)),""不一致"",""一致""))"
6
7    Books(0) = "C:\test\book0.xlsx"
8    Books(1) = "C:\test\book1.xlsx"
9    '・・・中略
10    Books(200) = "C:\test\book200.xlsx"
11
12    Application.ScreenUpdating = False
13    Application.Calculation = xlCalculationManual
14
15    With ThisWorkbook.Worksheets("イベント").Range("G1").CurrentRegion.Columns(1)
16        Dim b
17        For Each b In Books
18            Dim f As String
19            f = Replace(conFormula, "{外部参照}", ConvExtRefer(b))
20            .Offset(, 1).Formula = f
21            .Offset(, 1).Value = .Offset(, 1).Value
22            .Offset(, 2).Value = .Offset(, 1).Value    'I列に前の検索結果を保存
23        Next
24        .Offset(, 2).Clear
25    End With
26
27    Application.Calculation = xlCalculationManual
28    Application.ScreenUpdating = True
29End Sub
30
31'ファイルパスを外部参照式に変換
32'C:\test\book1.xlsx → C:\test[book1.xlsx]
33Public Function ConvExtRefer(FilePath As Variant) As String
34    Dim pos As Long
35    pos = InStrRev(FilePath, "\")
36    If pos > 0 Then
37        ConvExtRefer = Left(FilePath, pos) & "[" & Mid(FilePath, pos + 1) & "]"
38    End If
39End Function

コードの解説を少ししておきます。
まず、ワークシート関数の意味を理解しておきましょう。
MATCHを使って一致する位置を検索する。一致する値がないとエラーを返す。
IFERRORでエラーを-1に変換。
IF関数でｰ1を"不一致"それいがいを"一致"に変換。
このようにワークシート関数を組み合わせて、検索結果から"不一致"、"一致"を返す式を作成します。

VBAでセル範囲に式を設定することは、
ユーザーがセル範囲の先頭セルに式を設定してから、セル範囲最後までフィルハンドルをドラッグして式を自動入力することと同じ意味になります(オートフィル機能)。

式を設定して取得した値（一致、不一致）は、Valueで上書きすることで、式が値に変換されます。

あとは、{外部参照}の部分を、実際のファイルパスを外部参照式に変換したもので置き換えて、複数ファイルを参照できるようにしてます。

このように、式を使ってデータを参照する方法のメリットは、
ブックを一つずつ開く必要がない。
シート上のセルをループで一つずつ参照する必要がない。
ということです。この２つは重くなる二大原因ですので、これを回避できることで格段の高速化が可能になります。

ちみみに、セル結合があっても、MATCHでの検索は問題ないです。

投稿2020/08/11 21:07

編集2020/08/21 11:44

hatena19

総合スコア34075

yakumo02

2020/08/12 14:16

解説ありがとうございます！

hatena19

2020/08/12 14:30 編集

もし、外部参照式による検索の理解が難しいということなら、配列を使ってループするという方向性でもいいと思いますが、現状のコードを見る限り、配列の扱いも理解できいないようですし、道は遠そうです。また、高速化はそこそこです。格段の高速化を目指して、外部参照式の方法の理解を頑張るか、配列を使ってそこそこの高速化を目指すか、は、質問者さんの判断です。他にも配列で一つずつループして検索する方法以外にも、 WorksheetFunction.CountIf とか WorksheetFunction.Match で検索する方法もあります。こちらの方か配列より高速ですしシンプルになります。 https://office-hack.com/excel/countif-vba/ https://www.sejuku.net/blog/68671

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

同じデータを持っている訳でなく、問題を再現できないのでご提示のコードを読んだ限りでの指摘ですが：

(1) ご提示のコードの中、

VBA
1'関数呼び出し
2Call IsContained(target, filename)
3If IsContained(target, filename) = True Then    '戻り値がTrueだった場合

と、IsContained()関数を2回呼び出しています。1回目、Callが付いている方は意味ありませんね。これを除去するだけでも少し変わりませんか。

(2) Application.ScreenUpdating のFalse/Trueの切り替えとかThisWorkbook.Activateの実行とか、IsContained関数内でいちファイル毎に実行する必要はあるでしょうか。あまりパフォーマンスに関係ないかもしれませんし、このコードに限りませんが、同じ処理を何回も不必要に呼び出す必要がないよう、気を付けた方が良いです。

(3) 文字列が含まれているかどうか、ワークシートのCellsでいちセル毎にデータを読み出し、判定していますが、Rangeで範囲指定し、一度にデータを読み出すことで少しでも速くすることができると思います。

(4) 何回も同じExcelファイルを開いて比較するのはパフォーマンスに影響が出ていると思います。本当にそこが遅くなっているのであれば、1回読んだデータは、例えば量が少なければ変数に、量が多いのであれば別のテンポラリのテキストファイルに書き出し、次から（あるいは最初から）そこを読み出すようにすれば、全体として処理が速くなるはずです。要は、なるべくExcelのシートを直接読まないようにします。

(5) 更にちょっと元に戻って考えてみます。「Excelファイルを開くのは重い処理」と言う点は既に別のご質問の回答でもアドバイスいただいたことで、これは変えられません。全体として20分ほどかかっている処理が、実際にどこで時間がかかっているかを確認するのは大事です。まず、比較や判定結果の書き込みをしないで全部のExcelファイルを処理したとき、どれくらいの時間がかかっているのか確認しましょう。そこで結構な時間がかかっているのであれば、他の部分でどんなにコードをいじくっても効果的に速くすることはできません。最低限それだけの時間はかかってしまうということです。Excelのファイルを開くことで遅くなっているのであれば、それを極力減らす必要があります。勝手な思い込みと推測で、解決の為の作業時間を浪費しないよう気を付けましょう。

投稿2020/08/11 17:18

dodox86

総合スコア9256

yakumo02

2020/08/12 01:35

ご回答ありがとうございます (3)なのですがRangeでの範囲指定は("A1:A30")というかたちになると思いますが、今回の場合　If Workbooks(filename).Worksheets("説明").Cells(j, 81).Value Like target Then　を書き換える場合は Range("CC1:CCの最終行")になると思います。変数this_lineに最終行の列番号が入っているのですが、Rangeでthis_lineを使うのでしょうか？その場合の使い方が、調べても載っていないので、ご教授お願いしたいです

dodox86

2020/08/12 05:46 編集

> Range("CC1:CCの最終行")になると思います。 > 変数this_lineに最終行の列番号が入っているのですが、Rangeでthis_lineを使うのでしょうか？その場合の使い方が、調べても載っていないので、ご教授お願いしたいです Rangeでの指定はお書きになっているとおりRange("CC1:CCの最終行")のようになるのかと思いますが、文字列(String)が引数の型なので、this_lineの値をそれに適合させればよいです。例えばthis_lineの値が99だったとして、 Dim s As String s = "CC1:" & "CC" & CStr(this_line) とやると、sの値が"CC1:CC99" になります。これをRangeの引数として渡してあげます。以下のコードはCC1からthis_lineのところまでRangeから配列で取得して、その後その配列から文字列を取り出して","で繋げてデバッグ出力する例です。 '---- Dim s As String s = "CC1:" & "CC" & CStr(this_line) Debug.Print (s) Dim buf As Variant buf = this.Range(s) Dim data As String data = "" Dim i As Integer For i = 1 To this_line data = data & buf(i, 1) & "," Next i Debug.Print ("data=" & data) '---- 私が回答でRangeを挙げたのは、「なるべくまとめて処理をしよう」との意図で提案したものです。私の回答はどちらかと言うとExcelVBA固有で効率的な使い方をピンポイントで提案したものではなく、プログラミング一般の考えでしたものが主なので、別で回答いただいたhatena19さんの具体的な回答もぜひ参考にしてください。複数の回答があると迷ってしまうこともあるかと思いますが、yakumo02さんが内容を消化でき、より効率的な方法を採用することをお勧めします。

yakumo02

2020/08/12 06:18

ありがとうございます。以下にしてみましたが、型が一致しないエラーが出るのでます。調べるとcは配列扱いになっていると見たのですが、単にRangeの引数にしてはいけないのでしょうか？ Dim s As String s = "CC10:" & "CC" & CStr(this_line) If Workbooks(filename).Worksheets("サンプル").Range(s).Value Like target Then

dodox86

2020/08/12 06:25

> 調べるとcは配列扱いになっていると見たのですがそうです。Valueでは扱えません。あくまでRangeを使うのであれば使いかtから確認してください。

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

あまりコードの形を崩さずに、ファイルを早く開いて処理をする方法はありませんでしょうか？

んと、ひとつ一つのセルを読み、一つ一つのセルに書き込みを個々にすることが、
一番処理が重くなる原因です。（特に書き込みが重い）

以前に書いたと思いますが、
「値を一括でセル範囲に入力する。」
あるいは、「数式を一括でセル範囲に入力する。」
ということができるようになることが肝要かと思います。
それから、VBAでループの処理をすると重いです。
ループの回数をできるだけ減らす作業手順を考えるのと同時に、
エクセルの機能でできることはエクセルに任せることで、
VBAでループの処理を書かなくて済みます。

今回の件の場合、
数式を入力することで、
「ファイルを開く」ということを明示的に命令しなくて済むようになるので、
数式で、各ファイルを参照するようにしたらいいかなと思います。

手順としては、

1）数式を入れたいセル範囲の特定
2）仮の数式を一括で入力
3）対象ファイルの分だけ繰り返し
4）答えが一致でない数式の外部ファイルの参照部分を各対象ファイルのフルパスに置き換え
5)　3へ戻る
6）最後までループしてエラー値が残っていたら不一致に書き換える
7）セルの値を値のみにして数式を消す（必要ならば）

で、いいと思いますがいかがでしょうか？

答えが一致でないセルを検索するのは少々手間がかかるので、
数式で一致でないときはエラー値を返しておけば、
エクセルのジャンプ機能で数式の答えがエラー値のセルだけ検索できるので、
そのあたりを工夫するといいと思います。
数式の置き換えも個別にループするのではなく、
エクセルの置き換え機能を使えば、かなり速くなると思います。

「自分が現状でわかる」を優先するか、
も少し頑張って勉強して、「高速化を目指す」かの2択になるかと思います。

参考になれば。

投稿2020/08/12 09:37