エクセルのマクロで行と列の削除してCSV保存

Question

お世話になります。

あるフォルダに定型のエクセルファイル（内容のあるシートはSheet1だけ）が複数あり
マクロを用いて
1.そのファイルを開いて　特定の行（2行）と列（A列）を削除する。
2.CSV形式で保存する。　ファイル名は拡張子だけ違うだけで後は同じまま。
としたいと考えています。

マクロで
Sub 行列削除()
Range("A：A").Delete
Range("1：2").Delete
End Sub

としたシートに内容をコピペして実行すると行（2行）と列（A列）が削除できたのですが

複数あるエクセルファイルを
開いて、処理後、CSVでそれぞれ保存する方法が判らず困っています。

ご多忙のところ恐縮ですがご教示いただければ幸いです。

WindFaller · Accepted Answer

私の読み違えなのでしょうね、思惑とは違う内容になってしまいました。一応、ここらで、ひとまず、実行型のプログラムを形を整えないと目処が立ちません。「ファイルは開かないまま」で、実行してください。実際のパスの場所★を書き入れればよいです。xls? ファイルは、ほとんど全部処理します。ただし、パスワードなどについては考慮していませんので、失敗するとエラーが発生してしまいます。回避のオプションは取付可能です。画面の一番下に、処理しているファイル名は出ています。 1ディレクトリで、2000ファイルまで処理するようになっています。xlsx と xlms のベースファイルが同じ場合でも、枝番付きでコンフリクトを避けることが可能です。ただ、1回きりにしないと、同じものを枝番付きで増やしてしまいます。以下のマクロは、いろんなところに気を回していることが、逆にに少し悪ノリが過ぎていると感じるかもしれません。 '//ここから　（標準モジュール) Option Explicit Dim myPath As String Sub Main() 　'パスの場所　myPath = "C:\Users\[UserName]\Documents\Test1" '★ 　Dim wb As Workbook 　If Right(myPath, 1) <> "" Then myPath = myPath & "" 　Dim FName As String 　Dim i As Long, j As Long 　Dim myArray As Variant 　Application.ScreenUpdating = False 　　ReDim myArray(2000) 　i = 0 　FName = Dir(myPath & "*.xls?", vbNormal) 　Do While FName <> "" 　　If FName <> "." And FName <> ".." Then 　　　If (GetAttr(myPath & FName) And vbNormal) = vbNormal Then 　　　　　myArray(i) = FName 　　　　　i = i + 1 　　　End If 　　End If 　　FName = Dir 　Loop 　ReDim Preserve myArray(i - 1) 　Call MakingCSVFiles(myArray) 　Application.ScreenUpdating = True 　　MsgBox "Finish!" End Sub Sub MakingCSVFiles(myArray) 　Dim sh As Worksheet 　Dim rng As Range 　Dim buf As Variant 　Dim fileName As String, FName As String 　Dim ext As String: ext = ".csv" '拡張子　Dim j As Long, w As Variant 　Dim wb As Workbook 　Dim BaseName As String 　For Each w In myArray 　　'ステータスバーに処理中のファイル名を出す。　　Application.StatusBar = w 　　If w <> ThisWorkbook.Name And StrConv(Right(w, 1), vbLowerCase) <> "b" Then 　　　Set wb = Workbooks.Open(myPath & Trim(w)) 　　　ActiveSheet.Copy 　　　Set sh = ActiveSheet 　　　Set rng = sh.UsedRange 　　　rng.Offset(2, 1).Copy sh.Range("A1") 　　　If Application.CountA(Cells) = 0 Then 　　　 '開いた場所にデータがない場合　　　　 sh.Parent.Close False 　　　　 wb.Close False 　　　　 GoTo Endline 　　　End If 　　　j = 0 　　　BaseName = Mid(w, 1, InStr(w, ".") - 1) 　　　　　　Do While Dir(myPath & BaseName & ext) <> "" 　　　　If InStrRev(BaseName, "_") > 0 Then 　　　　　BaseName = Mid$(BaseName, 1, InStrRev(BaseName, "_") - 1) 　　　　End If 　　　　j = j + 1 　　　　BaseName = BaseName & "_" & CStr(j) 　　　Loop 　　　ActiveWorkbook.SaveAs myPath & BaseName & ext, xlCSV 　　　ActiveWorkbook.Close False 　　　On Error Resume Next 　　　wb.Close False 　　　On Error GoTo 0 　　End If Endline: 　Next w 　Application.StatusBar = "" End Sub '//ここまで

end-u · Answer

１．あるフォルダ（例えば　C:\Documents\●●●　というフォルダ）に１シートだけのエクセルファイルが沢山ある
２．エクセルファイルの名前は　book1.xlsx,aaa.xlsx,サンプル.xlsx..というように名前がランダム
３．フォルダ内の各ファイルを１つずつ開いてＡ列と１：２行を削除してＣＳＶファイルとして保存
４．ＣＳＶファイル名はエクセルファイルの名前に拡張子csvをつけたものにしたい
　　例えば　book1.csv,aaa.csv,サンプル.csv..
５．マクロを使ってそのフォルダ内の全エクセルファイルをまとめて処理したい

って事なんでしょうね、多分
質問の題名としては「フォルダ内の全てのBookに同じ処理を繰り返す」がしっくりくるのかな

３と４は[マクロの記録]を録る事で参考コードが解ります
５はVBAのDir関数を使う事になります
「フォルダ内の全てのBookに同じ処理を繰り返す」キーワードに検索すると参考Ｑ＆Ａがヒットすると思いますよ

WindFaller · Answer

>私のエクセルバージョンの問題かと思われます。
これについては、原因は分かりました。

>実行時エラー　'1004':
>'SaveAs'メソッドは失敗しました:'_Workbook'オブジェクト

Excel2007 でも、問題なく通りますが、それは、以下が解決してからのほうがよいです。

実は、私は、確信を持てないままにマクロコードを書き、様子をみることにしていたのです。それは想定内といえばそうなのですが、

私の書いたマクロには、ふたつ、大事なことが確認されていないのです。

>1.ファイル名はすべて異なり区別ができます。

これは、CSVにする時に、元のファイル名を使えるという意味なのですか？私は、使えないものとしていたのです。

例えば、File20161118.xlsx  ->File20161118.000
File20161118.001, File20161118.002 のようになっていきます。

「File20161118」拡張子を除いた部分を、マクロ文の中でも、「ベースネーム」という言い方をしていますが、私が書いたマクロは、このベースネームは同じで拡張子で振り分けるような内容になっています。エラーの原因は、マクロを正しく貼り付けていなかったことですが、ここは、実際は、どのようになっているのですか？

おそらく、私の書いていた内容とは違うはずです。

>2.同じフォルダにあり、他の拡張子のファイルはありません
つまり、拡張子は、.csv ではなく、000 から、001,002, と増えて付けられるようになっています。

たぶん、それも、ご要求とは違うはずです。

それを確認してから、直したほうが良いようです。

WindFaller · Answer

こんにちは。こんにちは。 >ファイル名は拡張子だけ違うだけで後は同じまま。補足側 >1.ファイル名はすべて異なり区別ができます。意味を取り違えてしまいました。ファイル名はみな同じで拡張子が変わるように理解してしまいました。拡張子は、CSVではないと読みましたが、それも何か怪しくなってしまいました。最初に、こういう出だしの時は、だいたい最後まで、ボタンの掛け違いが続くというのが、通例ですから、うまくないようなら、そのままにしておいてください。様子をみて、またお声をおかけするかもしれません。なお、2行と1列削除の操作も含まれています。それは、コピーして直してしまいました。開いているブックのみを処理するスタイルになっていますが、バイナリファイルはスキップします。また、2行と1列削除の操作も含まれています。それは、コピーして直してしまいました。最後に、なんとなく、ご質問の内容とはしっくりきていませんから、あまり内容が、かけ離れているようなら、ブレの少ないコード一つを選んで、そのコードに集中的に話を進めたほうが良いかと思います。 '// Option Explicit　'モジュールレベルの変数と定数 Dim myPath As String 'ベース名 Const BASENAME As String = "MYFILE" Sub Main() 　Dim wb As Workbook 　myPath = ThisWorkbook.Path 　If Right(myPath, 1) <> "\" Then myPath = myPath & "\" 　Application.ScreenUpdating = False 　For Each wb In Workbooks 　　If wb.Name <> ThisWorkbook.Name And Right(wb.Name, 1) <> "B" Then 　　　wb.Activate 　　　Debug.Print wb.Name 　　　Worksheets(1).Select 　　　Call MakingCSVFiles 　　End If 　Next wb 　Application.ScreenUpdating = True End Sub Sub MakingCSVFiles() Dim sh As Worksheet Dim rng As Range Dim buf As Variant Dim fileName As String, Fname As String Dim ext As String Dim j As Long ActiveSheet.Copy Set sh = ActiveSheet Set rng = sh.UsedRange rng.Offset(2, 1).Copy sh.Range("A1") fileName = BASENAME j = 0 ext = Format$(j, "000") Fname = Dir(myPath & fileName & "." & ext, vbNormal) Do While Fname <> "" 　　　buf = Mid$(Fname, InStrRev(Fname, ".") + 1) 　　　If IsNumeric(buf) Then 　　　　 ext = Format$(Val(buf) + 1, "000") 　　　Else 　　　　 j = j + 1 　　　　 ext = Format$(j, "000") 　　　End If 　　　Fname = Dir(myPath & fileName & "." & ext, vbNormal) 　Loop fileName = fileName & "." & ext ActiveWorkbook.SaveAs fileName, xlCSV ActiveWorkbook.Close False On Error Resume Next If Dir(myPath & fileName & ".csv") <> "" Then 　 Name fileName & ".csv" As fileName End If On Error GoTo 0 '' MsgBox "Save File as :" & FileName End Sub '// このような、ファイル保存のスタイルの場合は、SaveAs FileName, xlCSV としないと、現在のバージョンでは、正しく、CSVとして保存されません。他の方法だったら、任意の拡張子は可能です。

GooUserラック · Answer

その加工したいファイルはどうなっていますか？
① 特殊な名前になっていて他と区別ができる。
② 同じフォルダーに全てあって他の同じ拡張子のファイル無い。
などなら簡単に実現しそうです。

エクセルのマクロで行と列の削除してCSV保存

私の読み違えなのでしょうね、思惑とは違う内容になってしまいました。

１．あるフォルダ（例えば C:\Documents\●●● というフォルダ）に１シートだけのエクセルファイルが沢山ある

>私のエクセルバージョンの問題かと思われます。

こんにちは。

その加工したいファイルはどうなっていますか？

似たような質問が見つかりました

このQ&Aを見た人はこんなQ&Aも見ています

関連するカテゴリからQ&Aを探す

このQ&Aを見た人がよく見るQ&A

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング

１．あるフォルダ（例えば　C:\Documents\●●●　というフォルダ）に１シートだけのエクセルファイルが沢山ある