Top > フォルダー内のファイル名表示・計算
フォルダー内のすべてのファイル名表示と計算
フォルダーの中のエクセルのシートを全て自動計算させたいという話がありました。
ITの合理化は自動化させることです。
（ａ）フォルダー内のすべてのファイル名表示と計算
d:\excelkensu内にエクセルファイルがあります。
フォルダーの中のエクセルのシートを全て自動計算させたいという話がありました。
ITの合理化は自動化させることです。
指定したフォルダーの中のファイル名を返す関数Dirを使います。
ファイル名を変数bufに代入し空になるまでの繰り返しは
Do While 条件
Loop
を使います。
Windowsの前のMSDOSを使った方ならわかりますがファイルを全て検索するときは
Dir *.*
エクセルファイルのみ検索する場合は
Dir *.xlsx
をつかいました。今回もエクセルファイルだけなので*.xlsxを使います。
Sub kensu()
Dim i As Long
Dim buf As String
Dim Path As String
Path = "d:\excelkensu\"
buf = Dir(Path & "*.xlsx")
Do While buf <> ""
i = i + 1
buf = Dir()
Loop
MsgBox "全部で" & i & "個ファイルがありました"
End Sub
（ｂ）エクセルのファイル名をシートに表示(コピー)します。
変数bufにファイル名が入っていますからその値をセルに代入します。
Cells(i, 1) = buf
セルに代入ということは表示と同じです。
Sub hyouji()
Dim i As Long
Dim buf As String
Dim Path As String
Path = "d:\excelkensu\"
buf = Dir(Path & "*.xlsx")
Do While buf <> ""
i = i + 1
Cells(i, 1) = buf
buf = Dir()
Loop
End Sub
（ｃ）フォルダー内すべてのブックのシートの計算
各シートの１行１列に数字が入力されています。
その合計をシートに出力します。
エクセルファイルを検索するたびにそのファイルをオープンします。
変数keisanに加算しファイルを閉じ次のファイルを検索してなくなる迄繰り返します。
答えをCells(7, 1)に代入します。
Sub yobidasi()
Dim keisan As Long
Dim buf As String
Dim Path As String
Path = "d:\excelkensu\"
buf = Dir(Path & "*.xlsx")
Do While buf <> ""
Workbooks.Open Path & buf
keisan = keisan + Cells(1, 1)
ActiveWorkbook.Close
buf = Dir()
Loop
Cells(7, 1) = keisan
End Sub
（ｄ）フォルダー内すべてのブックの特定のセルとブック名を１枚のシートに集める
勤怠フォルダーの中のブックの特定のセルを新しいシートにコピーします。
各ブックの名前を取得してセルに貼り付けます。
Sub 取り込み()
Dim Path As String
Dim buf As String
Dim i As Long
Dim bname As String
Dim nagasa As Long
Path = "D:\勤怠\"
buf = Dir(Path & "*.xlsx")
i = 2
'合体シートにデータを転記するために消し、見出しを作成する
Worksheets("合体").Cells.Clear
Worksheets("合体").Cells(1, 1) = "名前"
Worksheets("合体").Cells(1, 2) = "合計数字"
'勤怠フォルダーのブックの決まった場所セルを順次合体シートに転記する
Do While buf <> ""
Workbooks.Open Path & buf
'ブックの名前から.xlsxを除いて取り出す
bname = Workbooks(2).Name
nagasa = Len(bname)
bname = Mid(bname, 1, nagasa - 5)
Workbooks(1).Worksheets("合体").Cells(i, 1) = bname
Workbooks(1).Worksheets("合体").Cells(i, 2) = Workbooks(2).Worksheets("勤怠").Cells(1, 2)
i = i + 1
ActiveWorkbook.Close
buf = Dir()
Loop
Worksheets("合体").Select
End Sub
