アプリ版:「スタンプのみでお礼する」機能のリリースについて

VBAは初心者で、やりたい操作が理解を超えているのでどうか知恵をお貸しください。

業務でcsvファイル(複数の種類があり列数行数も異なります)をダウンロードし、それをExcelファイルで操作することが多いのですが、書式を文字列で開かなければ桁数を保持できないデータが含まれており、その作業に時間を取られています。
そこでVBAを使って以下の操作ができればと考えております。

 ①csvファイルを格納しているフォルダを指定する。
 ②全ての列を文字列形式としてcsvファイルを開く。
 ③当該ファイルをxlsxに変換して同フォルダに保存する。
 ④ファイルを閉じる。
 ⑤フォルダ内のcsvファイル全てに①~④の操作を行う。

この操作が可能であればかなりの時間短縮になるのですが、これをしたいがためにVBAを調べ始めたような素人ですので全く力及ばず途方に暮れている状況です。
何もかも頼り切りな質問で恐縮ですが、ご教示いただきますと幸いです。

質問者からの補足コメント

  • >tatsumaru77 様

    ご質問の件、いずれのファイルも①カンマ区切り、②""で囲まれております。

    No.2の回答に寄せられた補足コメントです。 補足日時:2020/12/25 11:33

A 回答 (3件)

こんにちは



ご質問の内容は手動でも可能です。

「データの取得」からcsvファイルをテキストで読み込めば、そのままの内容を取得できます。
ただし、この場合はリンク状態になりますので、必要範囲をコピペしてから、読み込んだ方は削除してしまうのが簡単です。

VBA化したければ、こちらの方法であれば、「マクロの記録」をとればほぼそのまま利用できると思います。


>やりたい操作が理解を超えているので~
一気に全部を作成しようとすると、どこから手を付けたらよいのかわからないし、混乱してしまうかもしれません。
処理単位を分解して、部分を作成するような方法で学習しながら組み合わせてゆけば、最終的に目的のものを完成できるのではないかと思います。

以下は、基本的な部分になると思われる、「1ファイル分をテキストとして読み込んでシートに展開する」例です。
※ 例なので、Activesheetに展開しています。(最初にクリアしますのでご注意)
※ クォーテーションの処理は行っていません。(カンマがあればかまわず分割します)
※ ご質問の内容にしたければ、「フォルダを選択」して、その中のcsvファイルをループするようにすれば可能ですので、ゆっくりと挑戦してみてください。

Sub Sample_12095317()
Dim buf As String, rw As Long
Dim f, v

f = Application.GetOpenFilename("csv, *.csv")
If f = False Then Exit Sub

Cells.Clear
Cells.NumberFormatLocal = "@"

rw = 1
Open f For Input As #1
Do Until EOF(1)
 Line Input #1, buf
 v = Split(buf, ",")
 Cells(rw, 1).Resize(1, UBound(v) + 1).Value = v
 rw = rw + 1
Loop
Close #1
End Sub
    • good
    • 0
この回答へのお礼

>fujillin 様
ご回答ありがとうございます。
基本部分についてお教えいただき大変助かります。記録機能も使用してこれに肉付けする形で勉強をしてみようかと思います。

お礼日時:2020/12/25 11:25

区切り文字はカンマでしょうか。

それともスペースでしょうか。
各項目は""で、囲まれていますか。それとも、囲まれていませんか。
下記のどちらでしょうか。
123,456,789   ・・・・・①
"123","456","789" ・・・・・②
①でしょうか。それとも②でしょうか。
この回答への補足あり
    • good
    • 0

以下のマクロを標準モジュールに登録してください


-----------------------------------
Option Explicit

Public Sub CSV変換()
Dim fname As String
Dim wb As Workbook
Dim fd As fileDialog
Dim folder As String
Dim ctr As Long
Set fd = Application.fileDialog(msoFileDialogFolderPicker)
If fd.Show = False Then Exit Sub
folder = fd.SelectedItems(1)
fname = Dir(folder & "\*.csv")
ctr = 0
'フォルダ内の全CSVファイルを取得
Do While fname <> ""
Call make_book(folder, fname) 'CSVからbookを作成
ctr = ctr + 1
fname = Dir()
Loop
MsgBox (ctr & "件のファイル処理完了")
End Sub

Private Sub make_book(ByVal folder As String, ByVal fname As String)
Dim fpath As String
Dim bpath As String
Dim text As String
Dim data As Variant
Dim wdata As String
Dim i As Long
Dim wb As Workbook
Dim ws As Worksheet
Dim wrow As Long
Dim newsv As Long
newsv = Application.SheetsInNewWorkbook
Application.SheetsInNewWorkbook = 1
Set wb = Workbooks.Add(xlWBATWorksheet)
Application.SheetsInNewWorkbook = newsv
Set ws = Worksheets(1)
ws.Cells.NumberFormatLocal = "@"
fpath = folder & "\" & fname
bpath = folder & "\" & Left(fname, Len(fname) - 4) & ".xlsx"
Open fpath For Input As #1
'ファイル終端まで読み込む
wrow = 1
Do Until EOF(1)
Line Input #1, text
'カンマで分割
data = Split(text, ",")
For i = 0 To UBound(data)
'両端に""があれば、それをとって格納する
wdata = data(i)
If Left(wdata, 1) = """" And Right(wdata, 1) = """" And Len(wdata) > 1 Then
wdata = Mid(wdata, 2, Len(wdata) - 2)
End If
ws.Cells(wrow, i + 1).Value = wdata
Next
wrow = wrow + 1
Loop
Close #1
Application.DisplayAlerts = False
wb.SaveAs (bpath)
Application.DisplayAlerts = True
wb.Close
End Sub
    • good
    • 0
この回答へのお礼

>tatsumaru77 様
早速ご回答いただきありがとうございます。
正に求めていた操作そのものです。雑なお願いにもかかわらず一から作成いただき、いくら感謝しても足りません。
これからvbaを学ぶ中でまたご質問することがあるかもしれませんが、その際にはまたどうぞよろしくお願いいたします。

お礼日時:2020/12/25 14:12

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!