複数のCSVの指定行だけを残し、さらに行と列を入れ替えたい

Question

タイトルの通りとなりますが
現在Rドライブ直下に
R:\
111a.csv, 222g.csv, 333y.csv・・・
と複数のCSVファイルがあります。
CSVファイルの中身は

1 460-0031
2 愛知県名古屋市
3 中区本丸１−１
4 名古屋城様
5 電話番号
6 営業時間
…
13行目までと続きます。

１．この複数ファイルすべて［1行目から4行目のみ残し、残りの行はすべて削除したい］
２．この複数ファイルすべての行と列を入れ替えたい［1→A ２→B 3→C 4→D］

こちらを一つずつ処理、または同時に処理できる方法はありますでしょうか。
お答えいただけましたら幸いです。

WindFaller · Accepted Answer

確認を取らないまま、第三段目に入ります。

>Excelをお使いになるつもりなら、S-JISか、たぶん、Excel2013以上なら、UNICODEも範疇になるとは思います
と書いたにもかかわらず、Excelでは、UTF8のままで処理できるようです。

それで、以下は、UTF8 のままで出力を行っています。
呼び出しを、
ReproduceCSV2 →　ReproduceCSV3
に変えてくださっても良いかと思います。

なお、iMacros は、正直なところ、少しいじってはみたものの、よくわかりません。
Class や ID 名前をTAG の後に入れてもきちんと取れません。

私の最近の過去ログのいくつか見ていただければ分かりますが、Excelの中ですべて処理しています。みんなさん、私の作ったものは、あまりお気に召さない召さないようですが……。

一例：関税表
https://oshiete.goo.ne.jp/qa/9690445.html

Sub ReproduceCSV3(fName As String)
'UTF8に変換して出力
　Dim i As Long
　Dim TL As String
　Dim buf  As String
　Dim AdoStream As Object
　Set AdoStream = CreateObject("ADODB.Stream")
　With AdoStream
　　.Type = 2　' AdTypeText
　　.Charset = "UTF-8"
　　.Open
　　.LoadFromFile fName
　　Do While Not (.EOS)
　　　If i = 0 Then
　　　　buf = .ReadText(-2)
　　　Else
　　　　buf = buf & "," & .ReadText(-2)　'adReadLine
　　　End If
　　　i = i + 1
　　　If i >= 4 Then
　　　 .Position = 0
　　　 .SetEOS
　　　 .WriteText buf, 0 ' adWriteChar
　　　　Exit Do
　　　End If
　　Loop
　End With
　AdoStream.SaveToFile fName, 2　 'adSaveCreateOverWrite
　AdoStream.Close
　Set AdoStream = Nothing
End Sub

WindFaller · Answer

こんにちは。やっとすべて確認が取れました。をどう料理するのか、ということで、今、止まってしまいしました。 > ”CSVをエクセルで開く→保存する” iMacros そのもので、列を行に変換するぐらいは、修正はできるようです。 Excelで吸い上げて変換する必要はまったくないものの、今、この周辺は日本では大混乱の状態のようですね。日本は、この文字コードで頭を抱えているというのは、海外の人には分からないことなのです。「文字化け mojibake」は、そのまま英語でも通用するようです。以下のコードは、ぜんぜん不満足な内容なのですが、最終的なアプリが何かにも決まってきます。 Excelをお使いになるつもりなら、S-JISか、たぶん、Excel2013以上なら、UNICODEも範疇になるとは思います。今は、当面、S-JIS（現行のWindowsの設定？）の出力にしました。Excel自体では、文字化けはしないはずです。ここらへんの技術は、私は、まだ開発途上なのです。もう一年ぐらいになります。 UTF-8には二種類ありますが、FireFox とiMacros の利用では、UTF-8 BOM付きで出て来るようです。（もちろん、サイトの設定によるものです）以下の変更点は、ReproduceCSV　－>ReproduceCSV2 ReproduceCSV2 は、Import をAdodb.Stream に替えました。なお、こちらの読みが外れていたら、以下のコードでは、まったく解決にはなっておりませんので、あらかじめ、お詫びしておきます。 '// Sub CSVConvert() 　Const myFOLDER As String = "R:\" 　Dim fName As String 　Dim i As Long 　Dim buf 　fName = Dir(myFOLDER & "u*.csv", vbNormal)　'拡張子　Do While fName <> "" 　　If fName <> "." And fName <> ".." Then 　　　If (GetAttr(myFOLDER & fName) And vbNormal) = vbNormal Then 　　　 ReproduceCSV2 myFOLDER & fName　 '* 　　　　i = i + 1 　　　End If 　　End If 　　fName = Dir 　Loop 　MsgBox "finish! " & i, vbInformation End Sub Sub ReproduceCSV2(fName As String)　'* 'UTF8に変換して出力　Dim ExFno As Integer 　Dim i As Long 　Dim TL As String 　Dim buf 　Dim AdoStream As Object 　Set AdoStream = CreateObject("ADODB.Stream") 　With AdoStream 　　.Type = 2　' AdTypeText 　　.Charset = "UTF-8" 　　.Open 　　.LoadFromFile fName 　　Do While Not (.EOS) 　　　If i = 0 Then 　　　　buf = .ReadText(-2) 　　　Else 　　　　buf = buf & "," & .ReadText(-2)　'adReadLine 　　　End If 　　　i = i + 1 　　　If i >= 4 Then Exit Do 　　Loop 　End With 　ExFno = FreeFile() 　Kill fName 　Open fName For Output As #ExFno 　Print #ExFno, buf 　Close #ExFno End Sub

GooUserラック · Answer

それではこんな感じではいかがでしょうか？
---------------------------------------------------------------
Sub ファイル修正()
Const パス名 As String = "R:"
Dim ファイル名 As String
Dim データ As String
Dim 行数 As Long
Dim 文字列 As String
  ファイル名 = Dir(パス名 & "\*.csv")
  Do While ファイル名 <> ""
    Application.DisplayAlerts = False
    Workbooks.Open Filename:=ファイル名
    ActiveWorkbook.Save
    ActiveWindow.Close
    Application.DisplayAlerts = True
    行数 = 0
    文字列 = ""
    Open パス名 & "\" & ファイル名 For Input As #1
    Do Until EOF(1)
      Line Input #1, データ
      行数 = 行数 + 1
      文字列 = 文字列 & "," & データ
      If 行数 >= 4 Then Exit Do
    Loop
    Close #1
    If 行数 >= 4 Then
      文字列 = Mid(文字列, 2)
      Kill (パス名 & "\" & ファイル名)
      Open パス名 & "\" & ファイル名 For Output As #1
      Print #1, 文字列
      Close #1
    End If
    ファイル名 = Dir()
  Loop
  MsgBox ("終了しました")
End Sub

WindFaller · Answer

#5の回答者です。

>・文字化けしてしまう
>・行と列の置換が行われない

少なくとも、文字化けについては、アップロードする時に、ちらっと頭に浮かびました。なぜなら、この処理は、SJISで行っていたからです。
試しに、ANSIなら成功するかもしれません。
たぶん、文字認識していないから、そのようになるわけです。
ただ、CSV でこういうケースは、はじめてぐらいですね。

その元のファイルは、ExcelやOffice のアプリで生成されたものではありませんね。
もしかしたら、改行コードもCRLF ではないかもしれません。

ご面倒かもしれませんが、文字コードを調べてみていただけますか？
もしくは、どのような文字化けかみれば、だいたい想像付きます。

ただし、私が扱えるは、UTF-16(Unicode)までで、それ以上のものは、未知の世界です。

GooUserラック · Answer

念の為ですが、本当にRドライブ直下でしょうか？
もしかしたらネットワークドライブとかではないですよね？

GooUserラック · Answer

No.3 の修正です

次の２行は不要でした。
「Dim ファイル番号 As Long」
「ファイル番号 = ファイル番号 + 1」
途中テスト用で使っていたものが残っていました。

WindFaller · Answer

ドライブを指定するだけでよいです。

#3さんのは見ずに作ったけれども、判を押したように同じになりました。
一応、何度か検証されています。

'// 標準モジュール
Sub CSVConvert()
　Const myFolder As String = "R:\"　'ドライブ
　Dim fName As String
　Dim i As Long
　Dim buf
　fName = Dir(myFolder & "*.csv", vbNormal)　'拡張子
　Do While fName <> ""
　　If fName <> "." And fName <> ".." Then
　　　If (GetAttr(myFolder & fName) And vbNormal) = vbNormal Then
　　　 ReproduceCSV myFolder & fName
　　　　i = i + 1
　　　End If
　　End If
　　fName = Dir
　Loop
　MsgBox "finish! " & i, vbInformation
End Sub
Sub ReproduceCSV(fName As String)
　Dim InFno As Integer
　Dim ExFno As Integer
　Dim i As Long
　Dim TL As String
　Dim buf

　InFno = FreeFile()
　ExFno = FreeFile()
　Open fName For Input As #InFno
　Do While Not EOF(InFno)
　　Line Input #InFno, TL
　　buf = buf & "," & Trim(TL)
　　i = i + 1
　　If i >= 4 Then Exit Do
　Loop
　buf = Mid(buf, 2)
　Close #InFno
　Kill fName
　Open fName For Output As #ExFno
　Print #ExFno, buf
　Close #ExFno
End Sub

GooUserラック · Answer

No.3 の補足

Ｒドライブ直下の４行以上のＣＳＶファイルに対してのみ作用します。
繰り返して実行しても、加工されたファイルは１行になっているので対象外になるので問題は有りません。
「Const パス名 As String = "R:"」の「R」の部分さえ変更すれば他のドライブやパスでも使えます。

GooUserラック · Answer

とりあえずこんな感じではいかがでしょうか？
-------------------------------------------------------------------
Sub ファイル修正()
Const パス名 As String = "R:"
Dim ファイル名 As String
Dim ファイル番号 As Long
Dim データ As String
Dim 行数 As Long
Dim 文字列 As String
  ファイル名 = Dir(パス名 & "\*.csv")
  Do While ファイル名 <> ""
    行数 = 0
    文字列 = ""
    Open パス名 & "\" & ファイル名 For Input As #1
    Do Until EOF(1)
      Line Input #1, データ
      行数 = 行数 + 1
      文字列 = 文字列 & "," & データ
      If 行数 >= 4 Then Exit Do
    Loop
    Close #1
    If 行数 >= 4 Then
      文字列 = Mid(文字列, 2)
      Kill (パス名 & "\" & ファイル名)
      Open パス名 & "\" & ファイル名 For Output As #1
      Print #1, 文字列
      Close #1
    End If
    ファイル番号 = ファイル番号 + 1
    ファイル名 = Dir()
  Loop
  MsgBox ("終了しました")
End Sub
-------------------------------------------------------------------

mike_g · Answer

CSV の意味をご存知でしょうか？
Comma Separated Value で文字通りカンマ区切りのテキストファイルのことです。
お示しの「CSVファイルの中身」には「カンマ」が全く見当たらないのはどうしてでせうか？

複数のCSVの指定行だけを残し、さらに行と列を入れ替えたい

確認を取らないまま、第三段目に入ります。

こんにちは。

それではこんな感じではいかがでしょうか？

#5の回答者です。

念の為ですが、本当にRドライブ直下でしょうか？

No.3 の修正です

ドライブを指定するだけでよいです。

No.3 の補足

とりあえずこんな感じではいかがでしょうか？

CSV の意味をご存知でしょうか？

このQ&Aを見た人はこんなQ&Aも見ています

関連するカテゴリからQ&Aを探す

このQ&Aを見た人がよく見るQ&A

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング