人力検索はてな
モバイル版を表示しています。PC版はこちら
i-mobile

【Excel】フォルダ内に無数のCSVファイルが入っています。ファイル名は不定で、文字コードはSHIFT JISです。
ひとつのファイルは500?600行程度ですが、行数はデータによって不定です。しかし、必ず3の倍数+1行となっています。
この全ファイルから特定の項目を抜き出し、統合した1ファイルにしたいのです。

*CSVファイルの内容
冒頭3行はヘッダなので無視。
以降は3行ごとの繰り返し。

3n+1行目(A列の[]に囲まれた文字列の抽出)
"[XXXXXX1] 日本語による説明",

3n+2行目(A列の文字列とE列の数値の抽出)
"YYYYYY1","日本語による説明",0,0,100,

3n+3行目は無視したい。
かつ、最終の1行はフッタなので無視。

そして、希望するフォーマットは(CSV的に記述すると)以下の通りとなります。
"XXXXX1","YYYYYY1",100
"XXXXX2","YYYYYY2",50
以下つづく…

これを適当な名前をつけてXLSファイルとして保存してください。
また、作業が終わった多数のCSVファイルは削除して構いません。
手っ取り早そうなのはExcelのマクロのように思うのですが、他の方法でも構いません。

よろしくお願いいたします。

●質問者: raffine
●カテゴリ:コンピュータ
✍キーワード:CSV Excel JIS xls なのは
○ 状態 :終了
└ 回答数 : 4/4件

▽最新の回答へ

1 ● Mook
●30ポイント

VBA で処理をする例です(とりあえずファイルは消さないようにしました)。


A1セルに対象となるフォルダを入力し

(1) makeFileList を実行します。

例 C:\CsvData


A2セルに出力ファイル名(フォルダはA1)を入力し、

(2) makeNewFile を実行します。

例 AllData.csv


とした場合、C:\CsvData\AllData.csv に結果が出力されます。


'---------------------------------------------------------------------
' A1 フォルダ下にある CSV ファイルを B列にリストアップ
'---------------------------------------------------------------------
Sub makeFileList()
'-----------------------------------------------------------
 Dim fso As Object
 Set fso = CreateObject("Scripting.FileSystemObject")
 
'--- フォルダの有無のチェック
 If fso.FolderExists(Range("A1").Value) = False Then
 MsgBox "フォルダ[" & Range("A1").Value & "]がありません。"
 Exit Sub
 End If

'--- B列のクリア
 Columns("B").Clear

 Dim file As Object
 Dim lineNum As Long
 lineNum = 1
 For Each file In fso.getFolder(Range("A1").Value).Files
'--- CSVファイルの判定
 If InStr(UCase(file.Name), ".CSV") > 0 Then
 Cells(lineNum, "B").Value = file.Name
 lineNum = lineNum + 1
 End If
 Next
End Sub

'---------------------------------------------------------------------
' B列にあるファイルを規則にしたがって A2 ファイル(パスは A1)に出力
'---------------------------------------------------------------------
Sub makeNewFile()
'-----------------------------------------------------------
 Dim fso As Object
 Set fso = CreateObject("Scripting.FileSystemObject")

 Dim lastLine As Long
 lastLine = Range("B" & Rows.Count).End(xlUp).Row

'--- 出力ファイルをオープン
 Dim filePath As String
 filePath = Range("A1").Value & "\" & Range("A2").Value
 Dim dstFile As Object
 Set dstFile = fso.CreaTetextFile(filePath, True)
 
 Dim lines As Variant
 lines = Range("B" & Rows.Count).End(xlUp).Row
 Dim ll As Long
 Dim i As Long

 For i = 1 To lines
'--- 各CSVファイルを処理
 filePath = Range("A1").Value & "\" & Cells(i, "B").Value
 lines = Split(fso.OpenTextFile(filePath).ReadAll(), vbNewLine)
 For ll = 3 To UBound(lines) - 3 Step 3
'--- 各行を処理
 dstFile.WriteLine _
 """[" & lines(ll) & "]""," _
 & """" & lines(ll + 1) & """," _
 & lines(ll + 2)
 Next
 Next
 dstFile.Close
End Sub
◎質問者からの返答

申し訳ありません、質問の文字数制限で説明しきれませんでした。

元ファイルのうち必要な情報「だけ」を抜き出したいのです。

Mook様のマクロですと、ヘッダ・フッタのスキップはうまくいっていますがn+3行目のスキップがうまくいっていないようです。

あと、元ファイルにはすでに[ ]は記述されており、統合ファイル作成時には除去してしまいたいのです。

ただ、この結果をもとにすれば簡単な操作で目的は達せそうです。

ありがとうございました。

もう少し引き続き募集してみます。


2 ● nandedarou
●0ポイント

(1)csvファイルをダブルクリックして、エクセルで読み込む。

「新規テキスト文」というシートに読み込まれたものとして、以下、解説します。

(2)シートを追加する。

シート名のタブを右クリック→[挿入]をクリック→ワークシートが選択されているのを確認→[OK]をクリック

「Sheet1」というシートが追加されたものとして、以下、解説します。

(3)Sheet1のA1セルに、次の式を入力する。

=MID(OFFSET(新規テキスト文!$A$1,3*ROW(),0),2,FIND("]",新規テキスト文!$A$1)-2)

(4)Sheet1のB1セルに、次の式を入力する。

=OFFSET(新規テキスト文!$A$1,3*ROW()+1,0)

(5)Sheet1のC1セルに、次の式を入力する。

=OFFSET(新規テキスト文!$A$1,3*ROW()+1,4)

(6)範囲A1:C1を必要なだけ下にコピーして下さい。

※コピーのやり方

囲A1:C1をマウスで選択すると、太い線の四角で囲まれる。→その四角の右下の角を下にドラッグするとコピーされます。

(7)式を値に変換する。

データが表示された範囲を全て選択→右クリック→コピー→右クリック→形式を選択して貼り付け→[値]をチェック→[OK]

(8)「新規テキスト文」というシートを削除し、このブックを保存して完成。

以上です。

◎質問者からの返答

申し訳ありませんが、数千あるファイルをすべて「ダブルクリックで開く」というのは現実的ではありません。


3 ● Mook
●30ポイント

失礼しました。

仕様を読み間違えてましたね。


日本語の説明内に「, 」がないことが前提ですが、処理の部分を下記に置き換えてみてどうでしょうか。

 Dim words As Variant
 For i = 1 To lines
'--- 各CSVファイルを処理
 filePath = Range("A1").Value & "\" & Cells(i, "B").Value
 lines = Split(fso.OpenTextFile(filePath).ReadAll(), vbNewLine)
 For ll = 3 To UBound(lines) - 3 Step 3
'--- 各行を処理
 words = Split( lines(ll + 1), "," )
 dstFile.WriteLine _
 """[" & lines(ll) & "]""," _
 & """" & words(0) & """," _
 & words(4)
 Next
 Next

説明内に「,」がある場合は、別の方法が必要ですのでコメントください。

◎質問者からの返答

かなり近づいてきました。

元ファイルの1行目は、"[XXXXX1] 日本語"という状態ですが、このうちXXXXX1だけを抜き出したいのです。

つまり、角括弧の中身だけが必要で日本語部分も角括弧自体もばっさりカットしたいのですが…。


4 ● Mook
●30ポイント

たびたび失礼しました。

1行目の処理が、まだ仕様通りでは無いですね。


lastLine も正しく使われていなかったので、全体を修正して再掲しました。

こちらでどうでしょうか。

'---------------------------------------------------------------------
' A1 フォルダ下にある CSV ファイルを B列にリストアップ
'---------------------------------------------------------------------
Sub makeFileList()
'-----------------------------------------------------------
 Dim fso As Object
 Set fso = CreateObject("Scripting.FileSystemObject")
 
'--- フォルダの有無のチェック
 If fso.FolderExists(Range("A1").Value) = False Then
 MsgBox "フォルダ[" & Range("A1").Value & "]がありません。"
 Exit Sub
 End If

'--- B列のクリア
 Columns("B").Clear

 Dim file As Object
 Dim lineNum As Long
 lineNum = 1
 For Each file In fso.getFolder(Range("A1").Value).Files
'--- CSVファイルの判定
 If InStr(UCase(file.Name), ".CSV") > 0 Then
 Cells(lineNum, "B").Value = file.Name
 lineNum = lineNum + 1
 End If
 Next
End Sub

'---------------------------------------------------------------------
' B列にあるファイルを規則にしたがって A2 ファイル(パスは A1)に出力
'---------------------------------------------------------------------
Sub makeNewFile()
'-----------------------------------------------------------
 Dim fso As Object
 Set fso = CreateObject("Scripting.FileSystemObject")

 Dim lastLine As Long
 lastLine = Range("B" & Rows.Count).End(xlUp).Row

'--- 出力ファイルをオープン
 Dim filePath As String
 filePath = Range("A1").Value & "\" & Range("A2").Value
 Dim dstFile As Object
 Set dstFile = fso.CreaTetextFile(filePath, True)
 
 Dim ll As Long
 Dim i As Long

 Dim dataLines As Variant
 Dim data1 As String
 Dim words As Variant
 For i = 1 To lastLine
'--- 各CSVファイルを処理
 filePath = Range("A1").Value & "\" & Cells(i, "B").Value
 dataLines = Split(fso.OpenTextFile(filePath).ReadAll(), vbNewLine)
 For ll = 3 To UBound(dataLines) - 3 Step 3
'--- 各行を処理
 data1 = Replace(Left(dataLines(ll), InStr(dataLines(ll), "]") - 1), "[", "")
 words = Split(dataLines(ll + 1), ",")
 dstFile.WriteLine _
 """" & data1 & """," _
 & """" & words(0) & """," _
 & words(4)
 Next
 Next
 dstFile.Close
End Sub
◎質問者からの返答

ありがとうございます!これで仕様通りです!

終了させていただきます。

関連質問


●質問をもっと探す●



0.人力検索はてなトップ
8.このページを友達に紹介
9.このページの先頭へ
対応機種一覧
お問い合わせ
ヘルプ/お知らせ
ログイン
無料ユーザー登録
はてなトップ