• ベストアンサー
※ ChatGPTを利用し、要約された質問です(原文:[VBA]csvファイルを開いて保存(高速化))

[VBA]csvファイルの高速な開閉処理と保存

WindFallerの回答

  • ベストアンサー
回答No.2

こんにちは。 一応、処理するファイルは、目視で確認できるようになっています。また、同じファイル名があった時は、枝番が作られてから保存されます。保存ファイル型は、xlExcel8 (97-2003 format in Excel 2007-2013, xls) にしています。 ファイルフォルダと出力フォルダは、同じでも構いません。 もし、ブック名がぶつかることがあれば、枝番が付けられます。 '// Sub CSVImport2Sheet()  Dim orgHolder As String  Dim rw As Long, i As Long, j As Long, k As Integer, l As Long, m As Long  Dim Fn As Variant, Fnames As Variant  Dim FNo As Integer, TextLine As String  Dim LineBuf As Variant, U As Integer  Dim AcSht As Worksheet, WbkName As String, newBk As Workbook  Dim msg As String  Const PSWD As String = "abc" 'パスワード  Const EXT As String = ".xls" '文字列の先頭のピリオドは忘れないでください  '  ''必ず、末尾には、 '¥'を入れてください。  Const myHolder As String = "C:\Test1\" 'ファイルフォルダ  Const ExHolder As String = "C:\Test2\" '出力フォルダ  rw = 1 '書き出しの最初の行数  orgHolder = ThisWorkbook.Path  ChDir myHolder    '複数ファイルでも選択できます。  Fnames = Application.GetOpenFilename("CSV ファイル(*.csv),*.csv", MultiSelect:=True)  If VarType(Fnames) = vbBoolean Then   Exit Sub  End If  Application.ScreenUpdating = False  For Each Fn In Fnames   Set AcSht = Worksheets.Add(After:=Worksheets(Worksheets.Count))   FNo = FreeFile()   Open Fn For Input As #FNo 'ファイルインポート   Do Until EOF(FNo)    Line Input #FNo, TextLine    '「""」 の除去    'TextLine = Application.Substitute(TextLine, """", "")    LineBuf = Split(TextLine, ",")    U = UBound(LineBuf)    If U >= 0 Then     AcSht.Cells(rw + j, 1).Resize(, U + 1).Value = LineBuf    End If    j = j + 1   Loop   On Error Resume Next   Close #FNo   If WorksheetFunction.CountA(AcSht.UsedRange) > 0 Then '特に必要はないはず。空ファイルの除去    Fn = Dir(Fn)    'Debug.Print Fn 'ファイル名の確認    WbkName = Mid$(Fn, 1, InStrRev(Fn, ".") - 1)    AcSht.Name = WbkName    AcSht.Move    Set newBk = ActiveWorkbook    k = 1    '同名ファイルがある場合は、枝番が付けられます。    If Dir(ExHolder & WbkName & EXT) = "" Then     newBk.SaveAs ExHolder & WbkName & EXT, xlExcel8, PSWD    Else     Do Until Dir(ExHolder & WbkName & "_" & CStr(k) & EXT) = ""      k = k + 1     Loop     newBk.SaveAs ExHolder & WbkName & "_" & CStr(k) & EXT, xlExcel8, PSWD    End If    l = l + 1    newBk.Close False   Else    m = m + 1   End If    j = 0   On Error GoTo 0  Next  Application.ScreenUpdating = True    Set AcSht = Nothing  Set newBk = Nothing  ChDir orgHolder   msg = CStr(l) & " 個のファイルを処理し"   msg = msg & IIf(m > 0, vbCrLf & CStr(m) & " 個のファイルが処理できませんでした。", "ました。")   MsgBox msg, 64 End Sub '//

rihitomo
質問者

お礼

お礼が遅くなってすみません。 効率化できそうなところはcsvの読み込みの部分ということですね。 たしかにworkbooks.openしない分高速になりました。 ありがとうございました。 また、枝番の処理も教えていただきありがとうございます。

関連するQ&A

  • EXCEL VBA セルからファイル名を読み込む

    EXCEL VBAについての質問です 同じ処理を名前の違う複数のファイルで行いたいと思っています そこで、セルA2へファイル名の『○○.xls』○○部分だけをそれぞれのファイルに書き込んでおき、マクロは共通にしてファイル名をそれぞれのファイルから読み込んで実行したいと思っています。 良い方法を教えてください。 Workbooks("200809.csv").Activate Sheets("200809").Select Range("C3:C33").Copy Windows("○○.xls").Activate'←ここをファイルにあわせて変更できる形にしたい Sheets("報告書").Select Range("G5:G35").Select ActiveSheet.Paste Windows("200809.csv").Activate Range("K3:K33").Copy Windows("○○.xls").Activate’←ここ Sheets("報告書").Select Range("I5:I35").Select ActiveSheet.Paste Workbooks("200809.csv").Close SaveChanges:=False よろしくお願いします。

  • Excel CSVファイル セル名を名前として保存

    いつもありがとうございます。エクセル2003XPです。 毎回USBメモリーに上書きされてくる、同名のCSVファイルを別エクセルファイルに読み込む作業をしております。 その作業は外部データの読み込みを記憶マクロとして問題ないのですが、エクセルに読み込んだCSVファイルは、かぶらないようにそのつど、Kill を使い削除しております。 ただ完全に削除なので対策として、 読み込んだCSVファイルの1行目のセル名をファイル名として名前を変えて保存、 PCの"C:\Documents and Settings\元データ に毎回CSVもしくは、エクセルファイルに名前を変更して保存する処理をボタンひとつで出来ないか、考えております。 ネットで色々と検索をしておりますが、勉強不足です。 参考でサンプルマクロは見つけましたが、どのように変更すれば良いか分かりません。ご享受いただければ助かります。 CSVファイル名 : log001.csv(毎回、USB) 保存したいファイル名 : CSVファイルを開いた時のA1のセル名(日付です) 保存場所 : PCのマイドキュメントの元データファイル 保存したいファイル形式 : CSVもしくはExcelファイル Sub THSFILE_SAVE() Dim myFname0 As String Dim myFname As String On Error GoTo ERRH '現在のファイル名取得 myFname0 = ThisWorkbook.Name '新しいファイル名をセルA1の値とする myFname = Sheets(1).Range("A1").Value '同じ階層に保存 ThisWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & myFname If myFname0 <> myFname & ".xls" Then '前の名前のファイルを削除する場合は下の一行を有効にしてください 'Kill ThisWorkbook.Path & "\" & myFname0 End If Exit Sub ERRH: End Sub この処理はCSVファイルの読み込み先のエクセルファイルから、行いたいと考えております。 よろしくお願致します。

  • CSVファイルの読み書きについて

    みなさん、こんにちわ。 AというファイルからVBAを使ってデーターをCSV形式で書きだして、Bというファイルでその書き出したCSV形式のファイルを読み込んで、とある表を作成しています。 Bというファイルでの処理を外部に委託した時に、Aから書き出したCSV形式のファイルには、すべてのデーターが表示されていますので出来るなら見れないようにしたいと考えています。 Bファイルでの処理はあくまでも書き出したCSV形式のファイルを読み込むだけで、そのCSVファイルを見れないようにすることは出来ないのでしょうか? 暗号化・パスワード化はたまた別の方法どちらでもいいのですが、CSVファイルの中身がわからないようにし読み込みは今まで通りできればありがたいです。 勉強不足で誠に申し訳ないですが、どういった方法があるのか、どうすればいいのか教えて頂ければ有難いです。 よろしくお願いします。

  • CSVファイルの保存方法をお教えください

    Microsoft Office Personal 2010を使っています。 HogeHoge.csv をエクセルで開きます、この時シートの表示はHogeHoge.csv のままです 平均計算などの処理後このファイルを閉じようとすると下記のようなメッセージが出ます がこの時[はい]をクリックして閉じると正常に保存されるのですが マクロで保存をしようとするとなかなか上手くいきません。 A列の日付けが 2014/1/15 10:30 が 1/15/2014 10:30 となってしまいます。 HogeHoge.csvには、CSV(カンマ区切り)と互換性のない機能が含まれている可能性があります。この形式でブックを保存しますか? ・このまま保存するには、[はい]をクリックします。 ・機能を保存するには、[いいえ]をクリックしてから、最新のExcelの形式で保存します。 とでます   下記のようなマクロですがどのようにすれば良いのか分かりません   どうぞよろしくお願いいたします。 Sub 保存終了() ChDir "D:\DATA\BackT" ActiveSheet.SaveAs Filename:="D:\DATA\BackT\HogeHoge.csv", FileFormat _ :=xlCSV, CreateBackup:=False If Workbooks.Count = 1 Then Application.DisplayAlerts = False Application.Quit Else: ActiveWorkbook.Close False End If End Sub

  • エクセルファイル(book)のシートの内容をCSVファイルにおとしたい

    こんにちは。 VB初心者です。 実はVBではなく、Excel VBAで行なっているのですが。 ここに質問していいかもよく分かってないのですが。 プログラムの処理としては、あるBookのシートの内容を 別のCSVファイルとして生成したいのです。マクロを組んだのですが、一つ問題があって困っています。 問題: 生成したCSVファイルが一度Window上に表示されて (それはいいのですが、あとで閉じますから) 以下の確認メッセージがでてしまいます。 「outFile.csvはExcel97のファイル形式では、ありません。変更を保存しますか?」 要はプログラムがここで、一旦ユーザアクションを要求してしまうのです。 アクションなしに普通に終了させたいのですが。 マクロではなくVBだったらこんなことはならないのでしょうか? 初心なのでよく分かりません。 もしくはもっとほかの簡単なコードできるのでしょうか。 以下にコードを記述します。 Sub OutFile() Dim myWBpath As String myWBpath = ActiveWorkbook.Path Workbooks.Open FileName:=myWBpath & "\testData1.xls" Sheets("sheet1").Select ActiveWorkbook.SaveAs FileName:="C:\outFile.csv", _ FileFormat:=xlCSV, CreateBackup:=False ActiveWorkbook.Close End Sub

  • 大量のCSVファイルをExcel形式に変換する

    お世話になります。 大量のCSV(.csvファイルをExcel(.xls)ファイルに変換したい と考えております。 リネームソフトを使って、(.csv)⇒(.xls)の一括変換を したところ、拡張子は確かに.xlsに変換されたのですが、 中身はCSVのままとなっておりました。 (↑ファイル名とシート名が同期を取っているので) このCSVを確実にエクセル形式へと変換したいのですが、 どなた様かいいお考えをお持ちでしたら教えてください。 ググってみたところ、そういったアドインがあるのですが、 できれば費用をかけずに行いたいです…。

  • 上書き保存されない

    saveメソッドを使用しているのですが、上書きされないのです。 最初に名前をつけて保存で保存し、処理の最後にブック名を変数にして、saveで上書き保存しているのですが、なぜか教えてください。 Dim wb集計 As Workbook ActiveWorkbook.SaveAs Filename:="c:\集計.xls" 集計 = "集計.xls" Set wb集計 = Workbooks(集計) ~割愛~ wb集計.Save

  • 【Excel VBA】エクセルファイルを新規作成し、それを画面に表示せずに内容を変更するには?

    いつもお世話になっております。 今回はExcelのVBAについて質問があります。 例えば、以下のようにVBAを書くと、C:\test\1.xlsが作成され、その内容が変更されます。 Workbooks.Add.SaveAs dirName + "C:\test\1.xls" Workbooks("1.xls").Worksheets("Sheet1").Cells(1, 2).Value = 777 Workbooks("1.xls").Save Workbooks("1.xls").Close しかし、Workbooks.Add.SaveAsしてWorkbooks("1.xls").Closeするので、C:\test\1.xlsが一瞬画面に現れます。 それに、ちょっと動作が遅い感じがします(わざわざ画面に表示しているから?)。 C:\test\1.xlsを画面に表示させずに、その内容を変更する方法はありませんでしょうか? 実は、一つのExcelファイルの内容から、1000件程度のExcelファイルを作成する必要があります。 毎回、画面を表示していると大変遅くなってしまう恐れがあるのです。 上記の解決方法、又は参考になるWebサイトをご教示いただけると助かります。 以上、よろしくお願いします。

  • エクセルと同じファイル名でcsvを作成するマクロ

    エクセルからCSVファイルをYYMMDD付でマクロを使って 作ろうとしていますが拡張子の「.xls」がどうしても残ってしまいます。 例えば、「test.xls」が「test.xls070326.csv」のように。 これを「test070326.csv」とするにはどうしたらよいでしょう。 今のコードはつぎのようにしています。 Sub test1() Dim flname As Variant Dim wb As Workbook flname = ActiveWorkbook.Name + CStr(Format(Date, "yymmdd")) ActiveSheet.Copy ActiveSheet.SaveAs Filename:=flname, _ FileFormat:=xlCSV ActiveWindow.Close savechanges:=False ActiveWorkbook.Close End Sub これでもCSVとしては使えるのですが、気持ちがすっきりしません。 どなたか正解をお願いします。

  • VBAで名前を付けて保存

    テキストファイルをエクセル出力する処理を考えております。 テキストファイルを開き、名前をつけて保存する処理が上手くできません。 シート1のある2つのセルに入力パスと出力パスが設定されているとします。 例えばcells(4,4)に入力パスが設定されており(¥~~~.txt) cells(6,4)に出力パスが設定されており(¥~~~xls) 上記のような状態とします。 cells(4,4)にあるテキストファイルを開き、 それを拡張子をエクセルにしてcells(6.4)にある出力先に名前をつけて保存をしたいのです。 オープンする場合は Workbooks.OpenText Filename:=Workbooks("○○.xlsm").Sheets(1).Cells(4, 4).Value & ".TXT" で上手くいきました。 しかし保存の際に ActiveWorkbook.SaveAs Filename:=Sheets(1).Cells(6, 4).Value & ".xls" で実行するとエラーがでてしまいます。 どうすれば良いでしょうか。