エクセルVBAの配列二重ループ処理コードの書き方につきまして。

総合ファイルに、C:\testフォルダ配下にあるxlsxファイルを読み込んで書き出すという内容をしたいのです。各ファイルに書かれているA,B列の内容を、総合ファイルのA,B列に書き出す。という処理をしたいのです。ただ、条件があります。添付ファイルに状況を書いたものを添付させていただきます。

<条件>
E列に書き込んであるファイル名のファイルは、総合ファイルに書き込まずスキップする。
という内容でプログラムを書きたいのです。

現在、分かっている状態としては、

不明①：E列の対象外ファイルに書かれているファイルリストを配列に入れる方法が不明。
解決②：Dirを使い、対象ファイルをすべてとりだす。
不明③：1と2をwhileでの二重ループを行い、一致しなかったものは、【新規書込み対象配列】に【ファイル名】を代入。
解決④：ループ完了後、新規書込み対象配列から、該当ファイルを取り出し、書き込み処理をする。

という流れになるのかなと思っているのですが、【2重ループの書き方】、【対象外リストファイルと一致しなかったときの新規配列(＝Writefile)】への代入方法がわからないのです。


■コード
With CreateObject("WScript.Shell")
.CurrentDirectory = "C:\test\"
End With

不明①
BaseStartrow = 4
BaseEndrow = Cells(Rows.Count, 5).End(xlUp).Row '最終行を取得

'配列への書込み方法がわからないfile1とfile3を対象外配列に書き込みたい。
【コード不明】


②対象フォルダ内のファイルを取り出す。
Filename = Dir("*.xlsx")


③①と②の配列から値を取り出し、一致したら書き出し対象配列(=配列名Writefileと一応します)に、ファイル名(中身)を代入する
Do While Filename <> ""
【コード不明】
loop

④
Do While Writefile <> ""
【コード解決済み】
loop


お分かりの方がおられましたら、ご教示お願いします。
後、説明のために、簡単にしているのですが、一度書き込んだファイルは、E列の末尾にファイル名を追記する。という処理をしているので最終的にリストは200位になる可能性があるので、ループ処理が軽い物だと助かります。

よろしくお願いします。

質問者からの補足コメント

• 課題ではなくて、ただ複数のファイルを1つにまとめるのを手動でやるのがしんどくなってきているので、自分で書いたコードです。配列化する必要ないのですか。ちょっと再度考えてみます。

  No.3の回答に寄せられた補足コメントです。 補足日時：2022/01/06 22:46

• そうなんですね．①から③消去できるんですね。ありがとうございます。
  考えてきます。

  No.4の回答に寄せられた補足コメントです。 補足日時：2022/01/06 22:48

• [Open&Close の回数もどうなのかと気にはなりますが。]
  これについては、開いてコピーして、総合ファイルにペーストし、ペースト後はファイルを閉じるという処理をしています。
  
  ファイルを開かずにとりだす方法も考えてみることにします。

  No.5の回答に寄せられた補足コメントです。 補足日時：2022/01/06 22:50

• 

  ありがとうございました。何とか求める形になりました。
  たくさんの情報いただきありがとうございました。

    補足日時：2022/01/10 02:34

No.1 回答者： mygoonickname 回答日時： 2022/01/06 07:48

おはようございます。

一部になりますが、手書きなので、もしエラーになった場合はすみません
が、適宜修正をお願いします。

セル範囲を配列に入れる方法の例　myDatに2次元配列で入ります。

Dim myDat As Variant, I As Long, J As Long, myFlag As Boolen
myDat = Range(Range("E4"),Cells(Rows.Count, 5).End(xlUp)).Value

データが幾つかは、Uboundで取得が可能です。
きっと、配列名Writefileとの2重ループになるかと思いますが。
Writefileは、1次元配列でしょうか？

For J=Lbound(Writefile) to Ubound(Writefile)
myFlag=False
For I=1 to Ubound(myDat)
If myDat(I,1) = Writefile(J) Then
myFlag = True
End If
IF myFlag Then
’一致した場合の処理　書き出し？
End If
Next I

この回答へのお礼

コードのご提示までいただきありがとうございました。参考にさせていただき、あれから試してみたところ、ひとまず自分で書いたもので、追記したファイル処理なしで動きました。ありがとうございます。

お礼日時：2022/01/07 02:55