お世話になります。
あるフォルダに定型のエクセルファイル(内容のあるシートはSheet1だけ)が複数あり
マクロを用いて
1.そのファイルを開いて 特定の行(2行)と列(A列)を削除する。
2.CSV形式で保存する。 ファイル名は拡張子だけ違うだけで後は同じまま。
としたいと考えています。
マクロで
Sub 行列削除()
Range("A:A").Delete
Range("1:2").Delete
End Sub
としたシートに内容をコピペして実行すると行(2行)と列(A列)が削除できたのですが
複数あるエクセルファイルを
開いて、処理後、CSVでそれぞれ保存する方法が判らず困っています。
ご多忙のところ恐縮ですがご教示いただければ幸いです。
No.5ベストアンサー
- 回答日時:
私の読み違えなのでしょうね、思惑とは違う内容になってしまいました。
一応、ここらで、ひとまず、実行型のプログラムを形を整えないと目処が立ちません。「ファイルは開かないまま」で、実行してください。実際のパスの場所★を書き入れればよいです。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
'//ここまで
WindFaller 様
ご教示ありがとうございました。 フォルダまでのパスを書き換えて設定したところ
思い通りの結果が得られました。
末筆ながら、
迅速かつ丁寧なご指導を賜り心より感謝申し上げます。
季節の変わり目でございますので
お体をご自愛の上、益々のご活躍をお祈りしております。 <(_ _)>
No.4
- 回答日時:
1.あるフォルダ(例えば C:\Documents\●●● というフォルダ)に1シートだけのエクセルファイルが沢山ある
2.エクセルファイルの名前は book1.xlsx,aaa.xlsx,サンプル.xlsx..というように名前がランダム
3.フォルダ内の各ファイルを1つずつ開いてA列と1:2行を削除してCSVファイルとして保存
4.CSVファイル名はエクセルファイルの名前に拡張子csvをつけたものにしたい
例えば book1.csv,aaa.csv,サンプル.csv..
5.マクロを使ってそのフォルダ内の全エクセルファイルをまとめて処理したい
って事なんでしょうね、多分
質問の題名としては「フォルダ内の全てのBookに同じ処理を繰り返す」がしっくりくるのかな
3と4は[マクロの記録]を録る事で参考コードが解ります
5はVBAのDir関数を使う事になります
「フォルダ内の全てのBookに同じ処理を繰り返す」キーワードに検索すると参考Q&Aがヒットすると思いますよ
ご教示ありがとうございます。まさしく1~5のステップです。
「マクロの記録」でテストしてみたのですが ファイル名が一つしか選択できない状況です。
2.のランダムなファイル名のファイルを開いて 名前を付けて保存する流れが今一つ理解できていない状況です。
No.3
- 回答日時:
>私のエクセルバージョンの問題かと思われます。
これについては、原因は分かりました。
>実行時エラー '1004':
>'SaveAs'メソッドは失敗しました:'_Workbook'オブジェクト
Excel2007 でも、問題なく通りますが、それは、以下が解決してからのほうがよいです。
実は、私は、確信を持てないままにマクロコードを書き、様子をみることにしていたのです。それは想定内といえばそうなのですが、
私の書いたマクロには、ふたつ、大事なことが確認されていないのです。
>1.ファイル名はすべて異なり区別ができます。
これは、CSVにする時に、元のファイル名を使えるという意味なのですか?私は、使えないものとしていたのです。
例えば、File20161118.xlsx ->File20161118.000
File20161118.001, File20161118.002 のようになっていきます。
「File20161118」拡張子を除いた部分を、マクロ文の中でも、「ベースネーム」という言い方をしていますが、私が書いたマクロは、このベースネームは同じで拡張子で振り分けるような内容になっています。エラーの原因は、マクロを正しく貼り付けていなかったことですが、ここは、実際は、どのようになっているのですか?
おそらく、私の書いていた内容とは違うはずです。
>2.同じフォルダにあり、他の拡張子のファイルはありません
つまり、拡張子は、.csv ではなく、000 から、001,002, と増えて付けられるようになっています。
たぶん、それも、ご要求とは違うはずです。
それを確認してから、直したほうが良いようです。
No.2
- 回答日時:
こんにちは。
こんにちは。
>ファイル名は拡張子だけ違うだけで後は同じまま。
補足側
>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として保存されません。他の方法だったら、任意の拡張子は可能です。
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
このQ&Aを見た人はこんなQ&Aも見ています
-
ちょっと先の未来クイズ第2問
9月9日(月)に発表される「第3回子どもマネー川柳」に入賞する川柳を考えてこちらに投稿してください。
-
フォロワー20万人のアカウントであなたのあるあるを披露してみませんか?
あなたが普段思っている「これまだ誰も言ってなかったけど共感されるだろうな」というあるあるを教えてください
-
映画のエンドロール観る派?観ない派?
映画が終わった後、すぐに席を立って帰る方もちらほら見かけます。皆さんはエンドロールの最後まで観ていきますか?
-
海外旅行から帰ってきたら、まず何を食べる?
帰国して1番食べたくなるもの、食べたくなるだろうなと思うもの、皆さんはありますか?
-
天使と悪魔選手権
悪魔がこんなささやきをしていたら、天使のあなたはなんと言って止めますか?
-
VBA:Openステートメントで開いたCSVファイルの特定行を削除する方法
その他(プログラミング・Web制作)
-
Excelマクロ 空白セルを無視してCSV出力
Excel(エクセル)
-
Excel:任意の列だけCSV形式で出力したい。
Excel(エクセル)
-
関連するカテゴリからQ&Aを探す
おすすめ情報
- ・漫画をレンタルでお得に読める!
- ・人生のプチ美学を教えてください!!
- ・10秒目をつむったら…
- ・あなたの習慣について教えてください!!
- ・牛、豚、鶏、どれか一つ食べられなくなるとしたら?
- ・【大喜利】【投稿~9/18】 おとぎ話『桃太郎』の知られざるエピソード
- ・街中で見かけて「グッときた人」の思い出
- ・「一気に最後まで読んだ」本、教えて下さい!
- ・幼稚園時代「何組」でしたか?
- ・激凹みから立ち直る方法
- ・1つだけ過去を変えられるとしたら?
- ・【あるあるbot連動企画】あるあるbotに投稿したけど採用されなかったあるある募集
- ・【あるあるbot連動企画】フォロワー20万人のアカウントであなたのあるあるを披露してみませんか?
- ・映画のエンドロール観る派?観ない派?
- ・海外旅行から帰ってきたら、まず何を食べる?
- ・誕生日にもらった意外なもの
- ・天使と悪魔選手権
- ・ちょっと先の未来クイズ第2問
- ・【大喜利】【投稿~9/7】 ロボットの住む世界で流行ってる罰ゲームとは?
- ・推しミネラルウォーターはありますか?
- ・都道府県穴埋めゲーム
- ・この人頭いいなと思ったエピソード
- ・準・究極の選択
このQ&Aを見た人がよく見るQ&A
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
ファイルのアクセス回数について
-
エクセルのプロパティーでセキ...
-
Excel csv保存 列数が異なる場...
-
Wordで差込印刷した後に別々の...
-
ExcelブックをGoogleスプレッド...
-
マクロ実行後、表示がおかしくなる
-
エクセルファイル名に更新日時...
-
PowerPoint 2002でファイル名を...
-
エクセルVBAに詳しい方! マクロ...
-
VBAでマクロを使って、マクロ無...
-
Excel VBAにて「任意のエクセル...
-
エクセル UserForm 呼び出しで...
-
ファイル名のダブルクリックで...
-
エクセル2007でファイルを開く...
-
リストに基づいて画像名をリネーム
-
エクセルvbaでdocuworksprinter...
-
カンマ区切りのCSVファイルから...
-
エクセルで複数のコメントのサ...
-
Excel 相対パス
-
エクセルのハイパーリンクがコ...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
ファイルのアクセス回数について
-
エクセルのプロパティーでセキ...
-
ExcelブックをGoogleスプレッド...
-
Wordで差込印刷した後に別々の...
-
エクセル UserForm 呼び出しで...
-
エクセルファイル名に更新日時...
-
サブフォルダから部分一致のエ...
-
Excel csv保存 列数が異なる場...
-
マクロ実行後、表示がおかしくなる
-
EXCEL 検索時の設定
-
PowerPoint 2002でファイル名を...
-
Xlms とはなんでしょうか?
-
Word2010で閉じるボタン押下後...
-
vbaでボタンをクリックして上書...
-
エクセルのマクロで行と列の削...
-
エクセルでcsvファイルを開いて...
-
For~Nextルーチンで最初の1回...
-
VBAでマクロを使って、マクロ無...
-
大量のCSVファイルをExcel形式...
-
処理速度にムラがあり過ぎる
おすすめ情報
ご返信ありがとうございます。
1.ファイル名はすべて異なり区別ができます。
2.同じフォルダにあり、他の拡張子のファイルはありません
引き続きごご指導いただければ幸いに存じます。
ご教示ありがとうございます。
色々テストしているのですが 以下のところで止まってしまいます。
ActiveWorkbook.SaveAs fileName, xlCSV
実行時エラー '1004':
'SaveAs'メソッドは失敗しました:'_Workbook'オブジェクト
行と列が削除されてBook1、Book2,,,などとなってエクセルシートが表示されているところまで進んでいます。
おそらく私のエクセルバージョンの問題かと思われます。
最初にお伝えしていなかったことをお詫びいたします。
Ver2007です。申し訳ありません。<(_ _)>
ご教示ありがとうございます。
情報不足でお手数をおかけして申し訳ありません!
>1.ファイル名はすべて異なり区別ができます。
実際は、以下のようなファイル名がついて,同じフォルダ(Data_Files)内にあります
A001.xls 、A002.xls 、AB01.xls 、AC01.xls 、A111.xls
以下のように「エクセルのファイル名」を踏襲してCSVに変換して、
Data_Filesフォルダに保存できればと考えています。
A001.csv 、A002.csv 、AB01.csv 、AC01.csv 、A111.csv
引き続きで恐縮ですがご教示くださいませ。