以前のVBAのコードをVBA未経験者でも自由に使えるように修正
以前こちらの記事で一つのフォルダに格納されたたくさんのファイルに同じ処理をするVBAコードをご紹介しました。
その際に紹介した内容は「ファイルに決まった文字を入力する」という内容だったのですが、今回は逆にファイルの中に「記載されている値を抜き出す」というものになります。
また、どこの値を抜き出すのかをコードの中で指定するのではなく、ワークシートの中に対象セルの情報を記載するようにし、コードを編集しなくても抽出対象のセルを変更できるようにしました。
用意したワークシート
今回はフォルダに含まれているすべてのファイル(ブック)について、ファイルを開いてすべてのシートからセルの値を取得するVBAです。
以前からの改良点として、どこのセルの値を抜き出すか、セルの番地(A1とかB8など)をあらかじめツールのワークシートに記載しておくことで、VBAを知らない人でも使いこなせるように作ってみました。
一覧として抽出後、どのファイルのどのシートから抜き出した値かを確認できるようにするため、ファイル名・シート名を記載する列も用意しています。
スポンサーリンク
一つのフォルダに格納された複数のExcelファイルから特定のセルの値を抜き出し一覧にするExcelVBAコード
作成したコードは以下の通りです。
2行目の3列目以降にセルの番地を入力しておくことで、そのセルの値を対象シートから順に抜き出します。
1行目は何かメモを取ったりするために空けています。
Sub フォルダの中に含まれるファイルから値を順に取得する() Dim FolderName As String Dim FileName As String Dim Index As Integer Dim targetBook Dim targetSheet Dim i, k FolderName = Application.GetOpenFilename 'ダイアログを用いて選択したファイルのパスをFolderNameとする① If FolderName = "False" Then 'FolderNameが選択されていなければ作業を終了する Exit Sub End If '今のフォルダ名には選択したファイル名含まれているので、ファイル名の部分を切り取る作業。 Index = InStrRev(FolderName, "\") 'フォルダ名部分の文字数をカウントする FolderName = Left(FolderName, Index) ' カウントした文字数までの部分を切り取ってフォルダ名とする FileName = Dir(FolderName & "*xls*") ' フォルダの中に含まれるファイルを取り出す i = 3 '行の位置を設定するカウンタ Do While FileName <> "" ' ファイルがなくなるまで繰り返す Set targetBook = Workbooks.Open(FolderName & FileName) 'ファイルを開く For Each targetSheet In targetBook.Worksheets With ThisWorkbook.ActiveSheet .Cells(i, 1) = targetBook.Name '1列名はブック名 .Cells(i, 2) = targetSheet.Name '2列名はシート名 '3列目以降セルの値を抜き出す For k = 3 To .Cells(1, Columns.Count).End(xlToLeft).Column .Cells(i, k) = targetSheet.Range(.Cells(2, k)) '2行目に書かれている番地を対象シートから抽出 Next k End With i = i + 1 Next targetBook.Close Set targetBook = Nothing FileName = Dir() Loop End Sub
それほど複雑なコードでなく、行数も少ないわりにファイルが多いとめちゃくちゃ役に立つのでコスパが良いコードを作ることができました。
値の入力に関しても同じように作ったものをまたご紹介するようにします。
おすすめ書籍 (広告)
Amazon 楽天 Yahoo検索 |
---|
Amazon 価格:¥2,420円 |
楽天Kobo電子書籍ストア 価格:2,574円 |
楽天Kobo電子書籍ストア 価格:2,574円 |
bookfanプレミアム 価格:2,420円 |
bookfanプレミアム 価格:2,200円 |
コメント