Excelホルダ内のCSVにMacroを実行

前へ 次へ
このQ&Aのポイント
  • Excel VBA初心者です。指定ホルダ内の全てのCSVにMacroを実行する方法がわかりません。
  • 問題は、指定ホルダ内のCSVファイルを処理する際に、算出条件が見つからずにエラーが発生することです。
  • 解決のためには、作業用のBookにCSVデータを呼び出してMacroを実行し、保存する方法や、既存のMacroにコードを追加してBook内の算出条件を読み込ませる方法が考えられます。初心者のため、助けが必要です。
回答を見る
  • ベストアンサー

Excel　ホルダ内のCSVにMacroを実行

Excel VBA 初心者です。指定ホルダ内の全てのCSVにMacroを実行したいのですがうまくいきません。 対象データは指定ホルダ内の全CSVファイル。 算出条件がBook内にありますが（セル番地の数値を読むようにしてあります）、以下のMacroのCSV処理をすると算出条件が見つからなくてストップしてしまいます。（Book内のデータに実行した場合は問題ないです） ※「 'CSVに対する処理 ActiveなBookとして処理します。」の部分に処理用のMacroをCallしています。 上記の問題の解決として Ａ案 (1)作業用のBookにCSVのデータを[Sheet1]呼びだす→(2)Macroを実行→(3)保存 →(4)[Sheet1］のDataClear→(1)に戻り指定ホルダ内のファイルがなくなるまで繰り返す。 Ｂ案 以下のMacroにコードを付加してBook内の算出条件を読み込ませる。 と考えましたが、初心者故の未熟で解決できません。どなたか、助けてください。 何卒よろしくお願いいたします。 Sub Macro() Dim FSO, FDC, FL Dim FPath As String, Opath As String Dim i As Long Set FSO = CreateObject("Scripting.FileSystemObject") 'Filesystemobjectを使用する FPath = "E:\test\" '入力フォルダ Opath = "E:\test\ttt\" '出力フォルダ Set FDC = FSO.getfolder(FPath).Files 'パスのファイルコレクションを取得 For Each FL In FDC If UCase(FSO.GetExtensionName(FL)) = "CSV" Then '拡張子がCSVだったら Workbooks.Open FL 'Openする ' 'CSVに対する処理 ActiveなBookとして処理します。 ' Application.DisplayAlerts = False '保存しますかのメッセージを止める ActiveWorkbook.SaveAs Opath & "R" & FL.Name '名前を付けて保存 ActiveWorkbook.Close 'Closeする Application.DisplayAlerts = True 'メッセージ出力をもとに戻す End If Next End Sub

質問者が選んだベストアンサー

  • ベストアンサー
  • watabe007
  • ベストアンサー率62% (476/760)
回答No.1

>算出条件がBook内にありますが（セル番地の数値を読むようにしてあります）、 >MacroのCSV処理をすると算出条件が見つからなくてストップしてしまいます マクロでは算出条件が有るシートを、単にWorkSheets("・・・")　と書いているのでは CSVファイルを開いた時点でCSVファイルはActiveWorkbookになりますので 算出条件が書かれたシートは ThisWorkbook.WorkSheets("・・・") と、コードを直さないと >算出条件が見つからなくてストップしてしまいます。 と、なります。

  1. カテゴリ
  2. [技術者向] コンピューター
  3. プログラミング・開発
  4. Visual Basic

関連するQ&A

  • 自動範囲指定のデータをCSVで保存したい。

    添付ファイルにあるようにデータ(量が変化します)があり、自動的に最後の行まで指定してその範囲をダイヤログボックスを表示させてCSVとして保存したい。 今特に問題がある点は、 ・データのやり取りが出来ない点 ・CSVとして保存できない。(上記の点においてブランクの表が作成される) 何卒宜しくお願い致します。 '現在開いているシートをCSVデータで保存する Public Sub call_RangeSaveCSV() Dim fPath As String Dim fName As String Dim rng As Range Dim folderPath As String Fldr = "ダウンロード" '現在開いているブック情報をファイル名にするため、変数に格納 fPath = ActiveWorkbook.path & "\" fName = Left(ActiveWorkbook.Name, InStrRev(ActiveWorkbook.Name, ".")) & "csv" Application.DisplayAlerts = False '現在選択しているセル情報をrngに格納 'Set Rng = Selection Set rng = Range("L6").CurrentRegion '新規ブック作成→rngをA1にコピー→CSV保存→CSV閉じる Workbooks.Add rng.Copy ActiveSheet.Range("A1") '■ここでエラーが返ってきます。ダイヤログボックスを出して任意の場所と名前を付けたいのですが。。 ActiveWorkbook.SaveAs FileName:=fPath & fName, FileFormat:="Sample.csv", FileFilter:="CSVファイル(*.csv),*.csv") ActiveWorkbook.SaveAs ActiveWindow.Close Application.DisplayAlerts = True End Sub

  • ファイルサーバーからローカルフォルダーに移動したい

    下記のVBAはローカル環境でデータを同じフォルダーにCSVとして吐き出す事を目的に調べながら作ったのですが、運用の関係上ファイルサーバーへ置く事になってしまいローカルの「ダウンロード」フォルダーにに吐き出せないか色々試してみているのですが、どうしても分かりません。お知恵をいただければ幸いです。 宜しくお願い致します。 '現在開いているシートをCSVデータで保存する Public Sub call_RangeSaveCSV() Dim fPath As String Dim fName As String Dim rng As Range '現在開いているブック情報をファイル名にするため、変数に格納 fPath = ActiveWorkbook.Path & "\" fName = Left(ActiveWorkbook.Name, InStrRev(ActiveWorkbook.Name, ".")) & "csv" Application.DisplayAlerts = False '現在選択しているセル情報をrngに格納 Set rng = Selection '新規ブック作成→rngをA1にコピー→CSV保存→CSV閉じる Workbooks.Add rng.Copy ActiveSheet.Range("A1") ActiveWorkbook.SaveAs Filename:=fPath & fName, FileFormat:=xlCSV ActiveWindow.Close Application.DisplayAlerts = True End Sub

  • CSV取込みで最終行を取り込まない方法

    CSVの取込みで1行目のヘッダーと最終行のフッターを取り込まず 2行目～最終行の前までの中身だけを取り込みたいのですが、 1行目をスキップする方法は、下記を参照にしてなんとかできましたが、 http://detail.chiebukuro.yahoo.co.jp/qa/question_detail/q1230200277 ここに最終行をはぶくという処理をいれるにはどういたらいいでしょうか？ ---------------- Private Sub コマンド0_Click() Dim FSO As Object Dim InFile As Object Dim Outfile As Object Dim CsvPath As String Dim WorkPath As String Dim i As Long Const skipRow = 1 ''1行読み飛ばしの1 ''元のCSVファイルのフルパスに変更して！ CsvPath = "C\JPデータ取込CSV.csv" ''新しく作るCSVファイル。このMDBがあるフォルダにWork.csv 名で作られます。 WorkPath = CurrentProject.Path & "\Work.csv" '' FileSystemObjectのセット Set FSO = CreateObject("scripting.FileSystemObject") Set InFile = FSO.OpenTextFile(CsvPath, 1) Set Outfile = FSO.createTextFile(WorkPath) '' 読み飛ばし設定 For i = i To skipRow InFile.SkipLine Next i ''新しいCSVファイル作成 Outfile.Write InFile.ReadAll ''CSVファイルの終了と解放処理 Outfile.Close InFile.Close Set Outfile = Nothing Set InFile = Nothing ''Work.CSVファイルのインポート（今のDocmd以下をコピーし、ファイル名等を変更！） 'DoCmd.TransferText ・・・・・・ DoCmd.TransferText acImportDelim, "JPご清算書インポート定義", "T01_JPご精算書", WorkPath, True ''使用済みのWork．CSVを削除 FSO.DeleteFile WorkPath ''FileSystemObjectの解放 Set FSO = Nothing MsgBox "取り込み完了" End Sub

  • VBA：2つのCSVファイルを開きたいです。

    エクセル2010のVBAにてCSVファイルを開き結合させるプログラムを組もうとしているのですが、2つ目のCSVファイルを開こうとすると、何故かエラーが出てしまいます。 -------------------------------------------------------------------------------- 1つ目 Sub mobile_FileSearch(Path As String) 'test.csvのデータを検索して開く Dim FSO As Object, Folder As Variant, File As Variant Set FSO = CreateObject("Scripting.FileSystemObject") For Each Folder In FSO.GetFolder(Path).SubFolders Call mobile_FileSearch(Folder.Path) Next Folder For Each File In FSO.GetFolder(Path).Files If File.Name = "test.csv" Then Workbooks.Open ("test.csv") End If Next File End Sub ---------------------------------------------------------------------------- 2つ目 Sub local_FileSearch(Path As String) 'bbb.csvのデータを検索して開く Dim FSO As Object, Folder As Variant, File As Variant Set FSO = CreateObject("Scripting.FileSystemObject") For Each Folder In FSO.GetFolder(Path).SubFolders Call local_FileSearch(Folder.Path) Next Folder For Each File In FSO.GetFolder(Path).Files If File.Name = "bbb.csv" Then Workbooks.Open ("bbb.csv")'←ここでエラー End If Next File End Sub ------------------------------------------------------------------------ まったく同じプログラムで、csvファイル名だけ変えただけで実行時エラー1004が出てしまいます。 一体全体何が問題なのでしょうか？

  • エクセルVBAでのエラー

    おはようございます。 昨日ここでいろいろ教えていただき、300のエクセルファイルから特定の範囲のデータ抽出方法を書いてみたのですが、セルが多すぎて実行できません、というエラーがでてしまいます。 これはどのように解消すればよろしいのでしょうか？ Sub Test() Dim FPath1 As String, FPath2 As String Dim FName As String, myBook As String Const startROW As Long = 14, lastROW As Long = 20 Const startCOL As Long = 8, lastCOL As Long = 10 Const shtNAME As String = "sheet1" Application.ScreenUpdating = False FPath1 = "D:\MR5567\" FPath2 = "D:\New Microsoft Excel Worksheet\" Workbooks.Add myBook = ActiveWorkbook.Name FName = Dir$(FPath1 & "*.xls") Do While FName <> "" Workbooks.Open Filename:=FPath1 & FName ActiveWorkbook.Sheets.Select Sheets(1).Activate Sheets.Copy After:=Workbooks(myBook).Sheets(Sheets.Count) Workbooks(FName).Activate Application.DisplayAlerts = False ActiveWorkbook.Close FName = Dir$ Loop ActiveWorkbook.SaveAs Filename:=FPath2 & "Renketsu.xls", FileFormat:=xlNormal ActiveWorkbook.Close Application.ScreenUpdating = True End Sub

  • Excel vba 実行エラー1004

    (1)アクティブブックの名前を取得してセルＯ２に貼り付けた。ex. 1234567ｂ.CSV (2)ＶＢＡを使って1234567ｋ.CSV　におきかえた。 (3)(2)のセルに入力された内容でブックを開きたいが、エラー1004が出て開けない。 (4)開けたとして、そのブックのＡ１セルを　元のブックをアクティブにして　Ｄ１に　貼り付けたい。 (5)またさっきのブックに戻ってＦ１セルを　元のブックをアクティブにして　Ｅ１セルに貼り付けたい。 というようなＶＢＡを組みたいと思っています。 現在(1)(2)はできましたが(3)でエラーが出たため止まっていますし、その後もわかりません。 Dim bb As String Dim kb As String bb = ActiveWorkbook.Name Cells(2, "O").Value = ActiveWorkbook.Name Cells(3, "O").Value = ActiveWorkbook.Name Range("O2").Formula = Replace(bb, "b.CSV", "k.CSV") kb = Range("O2") 'シート名を取得する Dim bbs As String bbs = Left(bb, 10) Cells(4, "O").Value = bbs Dim kbs As String kbs = Left(kb, 10) Cells(5, "O").Value = kbs 'コピーして貼り付ける kbn = Cells(2, 15) Workbooks.Open Filename:=kbn Range("F1").Select Range("F1").Copy として作ってるんですが、 Workbooks.Open Filename:=kbn でエラーが出てブックが開けません。 ご指導お願いします。

  • ExcelシートをCSVファイルにする

    Excel2000を使用してます。 Excelブックに３つのシートがあります。 シート１はメインシートとして「ボタン1」「ボタン2」が存在してます シート２はインプットデータ用シート シート３はアウトプットデータ用シートです シート１の「ボタン1」を押すとVBAが実行されシート２の情報を読み、 シート３に算出結果を出力する仕組みです。 次にシート１の「ボタン2」を押すとシート３の内容をCSVに出力したいのですが、 下記のロッジクではうまくいきません。　どこを修正すればよいのでしょうか？ Sub CSV出力() Dim ONAME As String Dim しーと As Worksheet Dim 新しーと As Worksheet Dim PAS As String 'OUTパス名 PAS = ThisWorkbook.Path ONAME = PAS & "\" & "出力.CSV" '出力しーと Sheets("出力").Select Set しーと = ActiveSheet Set 新しーと = Worksheets.Add With 新しーと しーと.Copy .Move End With With ActiveWorkbook .SaveAs Filename:=ONAME, FileFormat:=xlCSV .Close False End With End Sub

  • Explorerのホルダー製作VBAの実行バッチ出来ますか

    ExcelのA1に C:\イ B1に朝 B2に昼 B3に晩　と記入し以下のBVAを実行すると　 「朝」「昼」「晩」と ホルダーが3個作れるのを教わりましたが、 C:\イからロハニ.....と十数個のディレクトリがあるとき全てに朝昼晩名の3個のホルダを作るバッチファイル 出来ますか？　 お助けください。 Sub DirListUp() Dim FPath, SubFld, Fld, RW FPath = Range("A1").Value If FPath <> "" Then Set SubFld = CreateObject("Scripting.FileSystemObject") _ .GetFolder(FPath).SubFolders RW = 1 For Each Fld In SubFld Range("B" & Format(RW)) = Fld.Name RW = RW + 1 Next End If End Sub

  • エクセルからＣＳＶファイルに出力したい？

    エクセルのシートからマクロを使ってＣＳＶファイルに出力したいです。 そこで調べたのですが、 http://oshiete1.goo.ne.jp/kotaeru.php3?q=2376607 こちらの質問で以下のようなコードが参考になりました。 Sub Macro1() Dim myBook As String myBook = ActiveWorkbook.FullName myBook = Left(myBook, Len(myBook) - 3) & "CSV" ActiveSheet.Copy ActiveWorkbook.SaveAs Filename:=myBook, FileFormat:=xlCSV ActiveWindow.Close False End Sub このコードではＣＳＶのファイル名がエクセルシートのファイル名になってしまいます。 今回の質問ですが、ＣＳＶファイルを違う名前で保存するにはどのようにすればいいのでしょうか？ （CSVファイルの名前は常にabc.csvで保存するものとします）

  • VBA　フォルダ内ファイルにマクロ一括処理

    フォルダ内ファイルのマクロを一括実行したいです。 フォルダ内ファイル全てに下記のマクロを登録 Sub 値貼り付け() 'シート4番目を選択 Sheets(4).Select 'シート名1文字目が「★」以外のシートを選択 For Each i In ThisWorkbook.Sheets If Not i.Name Like "★*" Then i.Select Replace:=False End If Next i '全セル選択 Cells.Select 'コピー Selection.Copy '値貼り付け Selection.PasteSpecial Paste:=xlPasteValues Cells(1, 1).Select Sheets(1).Select '「.xlsx」で保存 Application.DisplayAlerts = False Dim fso, f Set fso = CreateObject("Scripting.FileSystemObject") With ActiveWorkbook f = fso.GetBaseName(.Name) .SaveAs .Path & "\" & f & "保存.xlsx", FileFormat:=xlWorkbookDefault .Close End With Set fso = Nothing End Sub 一括でマクロを実行する用のファイルに下記マクロを登録 Sub 一括処理() Dim Fpath As String Dim Fname As String Dim Wb As Workbook Fpath = ThisWorkbook.Path & "\" Fname = Dir(Fpath & "*.xlsm") Do Until Fname = "" If Fname = ThisWorkbook.Name Then Else Application.DisplayAlerts = False 'ブックを開く Set Wb = Workbooks.Open(Fpath & Fname) 'マクロ実行 Application.Run "'" & Fname & "'!値貼り付け" Wb.Close SaveChanges:=True Application.DisplayAlerts = True End If Fname = Dir() Loop End Sub 一括処理の実行をすると、フォルダ内の一つのファイルだけ マクロ実行されると終了してしまいます。 各々のファイルには他にもマクロを登録していて、そちらは 'マクロ実行 Application.Run "'" & Fname & "'!値貼り付け" のマクロの名前部分を変更して、同様に一括処理していますが 問題なく動きます。 なぜかこの「値貼り付け」のマクロだけ全ファイルに動作して くれません。 色々自分なりに調べているのですが、どうしても原因不明で 今回投稿させて頂きました

注目のQ&A

カテゴリ

専門家に質問してみよう

職業から探して質問する

あなたにピッタリな商品が見つかる！ OKWAVEセレクト

質問する