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

質問です
c:\test\に複数のCSVファイルがあります
A列1行目からデータがあります。4行おきに1行空白があります

処理前
《名称》あああ
《TEL》088-888-8888
《〒》888-0088
《住所》あああいいいい

《名称》いいい
《TEL》099-999-9999
《〒》999-0099
《住所》いいいうううう

《名称》うううう
《TEL》077-777-7777
《〒》777-0077
《住所》うううええええ


処理後
あああ,088-888-8888,888-0088,あああいいいい
いいい,099-999-9999,999-0099,いいいうううう
うううう,077-777-7777,777-0077,うううええええ

の状態になるマクロをお願いします
《名称》
《TEL》
《〒》
《住所》
の4つを外して4つのカンマ区切りにする
名称,TEL,〒,住所

よろしくお願いします


●質問者: inosisi
●カテゴリ:ウェブ制作
○ 状態 :終了
└ 回答数 : 1/1件

▽最新の回答へ

質問者から

空白行は削除できます
《名称》
《TEL》
《〒》
《住所》
は外せます
データとしては
あああ
088-888-8888
888-0088
あああいいいい
いいい
099-999-9999
999-0099
いいいうううう
うううう
077-777-7777
777-0077
うううええええ

の状態です
よろしくお願いします


1 ● きゃづみぃ
●100ポイント ベストアンサー
Sub main()
Dim p As String
'対象フォルダを指定してください。
'このフォルダに この実行用のブックは 入れないでください。

p = "C:\test\"

'処理対象となる拡張子を指定して 呼び出します。
Call jikkou(p, "csv")

End Sub


Sub jikkou(p As String, s As String)

Dim bk() As String
Application.DisplayAlerts = False
 
f = Dir(p & "*." & s, vbNormal)

Do While f <> ""
 k = 0
 ReDim bk(k)
 
 ch1 = FreeFile
 Open p & f For Input As #ch1
 
 Do While Not EOF(ch1)  'ファイルの終端かどうかを確認します
 Line Input #ch1, textline  'データ行を読み込みます
 ReDim Preserve bk(k)
 bk(k) = textline
 k = k + 1
 Loop
 Close #ch1
 
 ch2 = FreeFile
 moji = ""
 kk = 0
 Open p & f For Output As #ch2
 For i = 0 To k - 1
 textline = bk(i)
 If Trim(textline) <> "" Then
 kk = kk + 1
 If kk > 4 Then
 Print #ch2, moji  'データの書き込みをします
 moji = textline
 kk = 1
 Else
 If moji = "" Then
 moji = textline
 Else
 moji = moji & "," & textline
 End If
 End If
 End If
 Next i
 
 If moji <> "" Then
 Print #ch2, moji  'データの書き込みをします
 End If
 
 Close #ch2
 
 f = Dir
Loop


Application.DisplayAlerts = True

End Sub



inosisiさんのコメント
有難うございました。 うまくいきました。 助かりました。 やっぱり 空白行削除のあと 《名称》 《TEL》 《〒》 《住所》 の4つを外して4つのカンマ区切りにする を一緒にできるとありがたいです 追加で100ポイント差しあげます

きゃづみぃさんのコメント
最初は それを削除するものを作ったんだけど よくよく読んでみたら ないようなので なくしちゃったんですよね。

きゃづみぃさんのコメント
>|vb| Sub main() Dim p As String '対象フォルダを指定してください。 'このフォルダに この実行用のブックは 入れないでください。 p = "C:\test\" '処理対象となる拡張子を指定して 呼び出します。 Call jikkou(p, "csv") End Sub Sub jikkou(p As String, s As String) Dim bk() As String Application.DisplayAlerts = False f = Dir(p & "*." & s, vbNormal) Do While f <> "" k = 0 ReDim bk(k) ch1 = FreeFile Open p & f For Input As #ch1 Do While Not EOF(ch1) 'ファイルの終端かどうかを確認します Line Input #ch1, textline 'データ行を読み込みます ReDim Preserve bk(k) bk(k) = textline k = k + 1 Loop Close #ch1 ch2 = FreeFile moji = "" kk = 0 Open p & f For Output As #ch2 For i = 0 To k - 1 textline = bk(i) If Trim(textline) <> "" Then kk = kk + 1 textline = Replace(textline, "《名称》", "") textline = Replace(textline, "《TEL》", "") textline = Replace(textline, "《〒》", "") textline = Replace(textline, "《住所》", "") If kk > 4 Then Print #ch2, moji 'データの書き込みをします moji = textline kk = 1 Else If moji = "" Then moji = textline Else moji = moji & "," & textline End If End If End If Next i If moji <> "" Then Print #ch2, moji 'データの書き込みをします End If Close #ch2 f = Dir Loop Application.DisplayAlerts = True End Sub ||<

inosisiさんのコメント
ありがとうがざいました。 完璧です。 手動で最初らるつもりでしたがこの方が断然速いです。 助かりました。

inosisiさんのコメント
追加ポイントのやり方を忘れてしまいました。 教えていただきたいのですが

きゃづみぃさんのコメント
https://www.hatena.ne.jp/shop/point/sendpoint こちらから送信できます。

inosisiさんのコメント
追加100ポイントを差し上げますので下記条件でカンマ区切りになるように お願いします 《名称》あああ 《TEL》088-888-8888 《〒》888-0088 《住所》あああいいいい 《名称》いいい 《TEL》099-999-9999 《〒》999-0099 《住所》いいいうううう 《名称》うううう 《TEL》077-777-7777 《〒》777-0077 《住所》うううええええ 1行目に空白行を設けても構いませんので 空白行から空白行の間の4行のデータは必ず同じ行にカンマ区切りされるよう チェック願います 名称の あああ いいい ううう はそれぞれ別物です

inosisiさんのコメント
処理後 あああ,088-888-8888,888-0088,あああいいいい いいい,099-999-9999,999-0099,いいいうううう うううう,077-777-7777,777-0077,うううええええ に必ずなるようにお願いします これになる条件は空白行で分かれていることです

きゃづみぃさんのコメント
最後のプログラムを実行して確認してみると 処理後の状態になります。 問題となるパターンを あげてください。

inosisiさんのコメント
《名称》 《TEL》 《回線》 《〒》 《住所》 のパターンがありました このパターンとの間のデータが崩れてしまっていますので 《回線》の行を削除してマクロ実行するとOKでした 《回線》の行がある場合その行を削除できますか?

きゃづみぃさんのコメント
プログラムとしては 連続する4つを 接続するようにしています。 《名称》 《TEL》 《〒》 《住所》 それぞれのワードをチェックして 連結するようにすれば いいかもしれませんね。

inosisiさんのコメント
ありがとうございました ソフトのほうで解決できましたので 今後の参考にします。

きゃづみぃさんのコメント
何かありましたら 別に質問だてしてもらったほうが わかりやすいかなと思います。

inosisiさんのコメント
ありがとうございました きゃづみぃさんにご紹介いただいたソフトで 解決いたしました。ありがとうございました。 また何かありもしたらよろしくお願いいたします。
関連質問

●質問をもっと探す●



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