ループが1回実行されるたびに値を1つずつ増やしてセルに検索した値を入力する

Excel VBA セルのデータ入力

前回のブログでは「セルの最終行を取得して検索した新しいデータを自動で追記していく」方法を書きました。

今回は開始行を自由に指定して、ループ処理で、検索で取得したファイル名とセルの値を一行ずつ増やしながら下のセルに書き込んでいく方法を書きたいと思います。

先ずはエクセルシート1のセルのA列とB列にファイル名とセルの値を入力する欄を作成します。

次にVBEの画面から「挿入」→「標準モジュール」で標準モジュールを作成します。

そして下のコードをコピーして標準モジュールのModule1に貼り付けます。

Sub ループが1回実行されるたびに値を1ずつ増やしてセルに検索した値を入力する()

Dim file_name As String
Dim folder_name As String
folder_name = ThisWorkbook.Path & "\検索フォルダ\" '検索するフォルダ名を変数に格納します。

Dim loop_count As Long
loop_count = 1 '行番号の初期値を1にします。

file_name = Dir(folder_name & "*.xlsx") 'Dir関数で検索します。

Do While file_name <> "" 'フォルダ内にエクセルのファイルが見つかる間は処理を行います。

Workbooks.Open folder_name & file_name 'ファイルを開きます。

loop_count = loop_count + 1 'ファイル名を表示する行を1つずつ増やしていきます。

With ThisWorkbook.Worksheets("Sheet1")

.Cells(loop_count, 1).Value = file_name
.Cells(loop_count, 2).Value = Workbooks(file_name).Worksheets("Sheet1").Range("A1").Value

End With

Workbooks(file_name).Close savechanges:=False 'ファイルを閉じます。

file_name = Dir() 'フォルダ内の次のファイルを検索します。

Loop

End Sub

【ファイルの保存】名前を付けて保存でファイル名を「マクロを実行するファイル.xlsm」として保存します。

【検索フォルダの作成】ファイルを検索する「検索フォルダ」を作成してその中に5つのファイルを入れます、ファイルAからファイルEのセルA1にはA~Eの文字を順番に入れて保存しておきます。

【同じフォルダに保存】「検索フォルダ」と「マクロを実行するファイル.xlsm」を同じフォルダに保存します。ThisWorkbookで保存場所を自動で取得するのでフォルダ名は自由に付けて差し支えありません。

【プログラムの実行】マクロを実行するファイル.xlsmのVBEの標準モジュールのコードを表示し「Sub/ユーザーフォームの実行」ボタンを押して標準モジュールのプログラムを実行します。

プログラムが終了するとエクセルシートのA列に「検索フォルダ」の中にあったファイル名とB列にはファイルA~ファイルEの「セルA1」に入っていた値が表示されます。

また次のような表でセルの11行目からデータ入力を始めたい場合は、プログラムの行番号の初期値を「loop_count = 1」から「loop_count = 10」と変更すれば11行目から入力を開始することができます。

今回紹介した開始行を自由に指定して入力していく方法は、シートの途中にある特定の表などの既存データを上書きしたり、その下に新しいデータを追記したりといった細かな制御が可能になるので是非ご活用ください。

コメント