Excel。Excel VBA初心者だってやりたい！大量のファイル。ファイル名の文字はバラバラ、空白も消してまとめて整えたい！
＜Excel VBA＞
各店舗などから送られてきたデータを集めてみたところ、ファイル名が次のようになっていました。
本来は、従業員コード+氏名+test+日付（半角）という形式のファイル名にして送信してほしかったのですが、ルールに従ってくれていません。
testとしないといけないのに、テストとカタカナになっている。
２０１９と半角数字なのに、全角
ファイル名の中に、半角の空白や、全角の空白が入っている。
これをルールに従ったファイル名の形式に整えたいわけです。
本当は、次のようにしたほしかったわけです。
今回はサンプルなので、5件ぐらいなら、根性を入れれば修正できないこともありませんが、ファイル数が多くなると、面倒以外の何物でもありません。
イライラするだけですね。
こういう、単純な処理もマクロ。
Excel VBAを使うことで簡単にファイル名を整えることができます。
【考え方】
Excelのセル内の文字を置換することは簡単ですが、ファイル名はダイレクトに変更することは難しいので、次のような工程で変更していきます。
フォルダーにある、ファイル名をExcelに取り込む。
正しい形に整える。
整えたファイル名に置換する。
この作業工程に沿って、Excel VBAを作っていきましょう。
【Excel VBAを作ってみよう】
次のようにExcel VBAを入力します。
Sub File_Name()
Dim buf As String, buf2 As String
Dim cnt As Long
Dim EndRow As Long
Dim fname As String, fname2 As String
Dim Newfname As String, Newfname2 As String
buf = Dir("C:\Users\ Desktop\ExceVBA\*.xlsx")
buf2 = "C:\Users\ Desktop\ExceVBA\"
Do While buf <> ""
cnt = cnt + 1
Cells(cnt, "a") = buf
buf = Dir()
Loop
Range("a:a").Copy Destination:=Range("b1")
'データの最終行を検索
EndRow = Range("a1").End(xlDown).Row
For cnt = 1 To EndRow
Cells(cnt, "b").Value = StrConv(Cells(cnt, "a"), vbNarrow)
Cells(cnt, "b").Value = Replace(Cells(cnt, "b").Value, "ﾃｽﾄ", "test")
Cells(cnt, "b").Value = Replace(Cells(cnt, "b").Value, " ", "")
Next
For cnt = 1 To EndRow
fname = Cells(cnt, "a").Value
Newfname = Cells(cnt, "b").Value
fname2 = buf2 & fname
Newfname2 = buf2 & Newfname
If Right(Newfname, 1) = "x" Then
Name fname2 As Newfname2
End If
Next
End Sub
ちょっと長いかもしれませんが、説明をしていきます。
最初は、変数宣言のブロックですね。
Dim buf As String, buf2 As String
Dim cnt As Long
Dim EndRow As Long
Dim fname As String, fname2 As String
Dim Newfname As String, Newfname2 As String
それぞれの変数がどこでどう使っているのかは、後述します。
慣れるまでは、一行に一つの変数宣言文を書く方がいいのと思いますが、同じ型ならば、「,」（カンマ）で区切ることもできます。
パスを変数に代入します。
buf = Dir("C:\Users\ Desktop\ExceVBA\*.xlsx")
Dirの引数は、パスといって、今回修正したいファイルの場所をExcelに教えてあげる必要があります。
Excelファイルをダブルクリックで起動すると、パスの情報がないので、設定しておくといいですね。
buf2 = "C:\Users\ Desktop\ExceVBA\"
こちらは、ファイル名を置換する時に使うパスです。
なお、このパスは、使用しているPCによって変わりますので、実際に使用する時には、それぞれの環境に合わせて修正する必要があります。
このままでは使用できませんので注意しましょう。
【ファイル名をExcelに取り込む】
Do While buf <> ""
cnt = cnt + 1
Cells(cnt, "a") = buf
buf = Dir()
Loop
ここで、フォルダーにあるファイルのファイル名を取り込む作業をします。
Do While buf <> ""～Loop
これで、フォルダー内にあるファイルをすべて検索することができます。
cnt = cnt + 1
Cells(cnt, "a") = buf
bufには、"C:\Users\ Desktop\ExceVBA\*.xlsx"。
つまり、ファイル名が代入されています。このファイル名を、Cells(cnt, "a")に入力します。cnt=1なので、A1に入力するわけですね。
buf = Dir()
で一度、クリアーします。
すると、Excelのシートには、次のように入力されます。
これで、フォルダー内にあるファイル名を抽出することができました。
【置換するための整えたファイル名を作る準備】
抽出したファイル名をB列にコピーして、コピーしたB列を修正していきます。
Range("a:a").Copy Destination:=Range("b1")
データの件数を数えているのが面倒なので、列選択して、B1に貼り付ければコピー完了ですね。
【ファイル名を整える】
フォルダー内に何件のファイルがあるのかを確認するのは面倒ですし、無駄な繰り返し処理をさせると処理速度が悪化しますので、繰り返し処理を行うために、データの最終行の行番号を取得させます。
EndRow = Range("a1").End(xlDown).Row
For cnt = 1 To EndRow
Cells(cnt, "b").Value = StrConv(Cells(cnt, "a"), vbNarrow)
Cells(cnt, "b").Value = Replace(Cells(cnt, "b").Value, "ﾃｽﾄ", "test")
Cells(cnt, "b").Value = Replace(Cells(cnt, "b").Value, " ", "")
Next
Cells(cnt, "b").Value = StrConv(Cells(cnt, "a"), vbNarrow)
vbNarrowは、全角文字を半角文字に変換する処理をしています。
この処理で、２０１９という全角数値は、半角数値に置換することができます。
Cells(cnt, "b").Value = Replace(Cells(cnt, "b").Value, "ﾃｽﾄ", "test")
この行は、半角文字のテストがあれば、testに置換する処理をしています。
ファイル名は全角のテストだったのでは？と思われるかもしれませんが、先程の、
Cells(cnt, "b").Value = StrConv(Cells(cnt, "a"), vbNarrow)
で、全角を半角にしています。
つまり、全角カタカナも半角カタカナに置換されてしまっているので、半角のテストを置換するようにしているわけです。
あと、半角全角の入力ミスではなくて、完全に誤植の場合、どうしたらいいですか？とよく質問があるのですが、誤植のケースが無限大ですから、直しようがありません。
Cells(cnt, "b").Value = Replace(Cells(cnt, "b").Value, " ", "")
この行は、全角・半角を問わず、空白を削除する行です。
Replaceではなくて、Trimじゃないの？と思いますが、Trimは、文字列の前後の空白は削除しますが、文字列の途中の空白は削除しません。
連続する空白でも、空白一つは残してしまうので、Replaceがオススメです。
【ファイル名を置換する】
For cnt = 1 To EndRow
fname = Cells(cnt, "a").Value
Newfname = Cells(cnt, "b").Value
fname2 = buf2 & fname
Newfname2 = buf2 & Newfname
If Right(Newfname, 1) = "x" Then
Name fname2 As Newfname2
End If
Next
いよいよ、整えたファイル名を使って置換する処理です。
fnameには、A1のデータを代入します。同じように、Newfnameには、B1のデータを代入します。
パスを付けないと、どこにファイルがあるのか、Excelはわかりませんので、
fname2に、パス＋A1として、パスが付いたファイル名を作ることができます。
Newfname2も同じような処理をしています。
なお、
buf2 = "C:\Users\ Desktop\ExceVBA\"
は、ここで使うために設定してあったわけです。
If Right(Newfname, 1) = "x" Then
Name fname2 As Newfname2
End If
意図しないものを変換しないようにします。
拡張子の最後の一文字が、「x」でない場合は、置換させないようにします。
Name fname2 As Newfname2
Name ～ Asを使うことで、ファイル名を置換することが簡単にできます。
このように、Excelそのものでなくても、Excel VBAを使うことで、ファイル名も一括で修正することができます。
