ｴｸｾﾙ2019VBAで空白行を削除し詰めてCSV書き出ししたい｡会員ﾃﾞｰﾀをｴｸｾﾙ2019のﾌｨﾙﾀｰで表示した時に､非表示の行が出来ます｡ CSVで出力するとこの空白行は …

ｴｸｾﾙ2019VBAで空白行を削除し詰めてCSV書き出ししたい｡

会員ﾃﾞｰﾀをｴｸｾﾙ2019のﾌｨﾙﾀｰで表示した時に､非表示の行が出来ます｡
CSVで出力するとこの空白行は
,,,,,,,
のような形で出力されてしまいます｡

これを行ごと削除して詰めて出力したいです｡

会員ｼｽﾃﾑで会員情報をｴｸｾﾙ形式でﾀﾞｳﾝﾛｰﾄﾞし､ﾌｨﾙﾀｰを掛けます｡

すると
実際は3,4行目はﾌｨﾙﾀｰで非表示ですが､CSVで書き出すと下記の様になります｡

A B C
1 青木,2月,ﾒｰﾙ配信可,-
2 秋葉,2月,ﾒｰﾙ配信可,-
3
4 安部,2月,ﾒｰﾙ配信可,-
5 田村,2月,ﾒｰﾙ配信可,-
6 高橋,2月,ﾒｰﾙ配信可,-
7
8 野村,2月,ﾒｰﾙ配信可,-
9 田村,2月,ﾒｰﾙ配信可,-

※元ﾃﾞｰﾀを別ｼｰﾄに抽出していますので上記のﾃﾞｰﾀは関数(抽出結果)です｡
※空白行は""で出力しています｡
※実際は空白行に,,,などのｺﾝﾏが並んでいますが､他の方の説明で使われていた下記VBAの式をいれると上記のようになります｡

よろしくお願い致します｡

Sub macro1()

Dim h As Range

Dim buf As String

Dim FileN As String

FileN = Application.GetSaveAsFilename( _

InitialFileName:="book1.csv", _

FileFilter:="CSV ﾌｧｲﾙ (*.csv), *.csv")

Open FileN For Output As #1

With Application

For Each h In Range("A1:A" & Range("A65536").End(xlUp).Row)

buf = Join(.Transpose(.Transpose(Range(h, Cells(h.Row, "IV")).Value)), " ")

buf = .Trim(buf)

buf = Replace(buf, " ", ",")

Print #1, buf

End With

Close #1

End Sub

範囲に関しては記載の仕方がよくわからないので､上から下まで全部対象にしたいです｡

ｱｸﾃｨﾌﾞﾚﾝｼﾞという項目を使うとこの空白行を詰めることが出来るみたいなのですが､変更するとｴﾗｰになってしまいますので､これを使用したやり方でも､そうでないやり方でもお教え頂けると嬉しいです｡

よろしくお願い致します｡

＞CSVで出力するとこの空白行は

＞,,,,,,,

＞のような形で出力されてしまいます｡

CSVで出力するｺｰﾄﾞを一部抜き出すと

buf = .Trim(buf)

buf = Replace(buf, " ", ",")

Print #1, buf

の部分で､

buf = Replace(buf, " ", ",")

Print #1, buf

かな｡

＞,,,,,,,

＞のような形で出力

なので､

＞,,,,,,,

の時は､出力したくないので※しつこいな

buf = .Trim(buf)
If Len(Trim(buf)) > 7 Then '7文字以上ならﾃﾞｰﾀありにする？手抜きだけど 
 buf = Replace(buf, " ", ",") 'ｽﾍﾟｰｽをｶﾝﾏにしてから
 Print #1, buf 'ﾃｷｽﾄﾌｧｲﾙ csvへ一行書き込む
End If

↑なんか変だけど､

現在

＞,,,,,,,

＞のような形で出力

は､動いているので､

単純に If Len(Trim(buf)) > 7 Then とかbufがLenで調べて7文字以上なら書き出す

そんな手抜き処置を提案してみたり｡

手抜き回答ですが､解決のﾋﾝﾄとなれば幸いです｡

※外していたらｽﾐﾏｾﾝ｡と定型文を書きつつ､うまく動くといいな･･･

あっ､

＞※実際は空白行に,,,などのｺﾝﾏが並んでいますが､

＞他の方の説明で使われていた下記VBAの式をいれると上記のようになります｡

空白行までできてるなら､

buf = .Trim(buf) '←あっ､ここで､Bufから空白抜いてるｼﾞｬﾝ､見落とした･･･
If Len(buf) > 1 Then '1文字以上ならﾃﾞｰﾀありにする？手抜きだけど 
 buf = Replace(buf, " ", ",") 'ｽﾍﾟｰｽをｶﾝﾏにしてから
 Print #1, buf 'ﾃｷｽﾄﾌｧｲﾙ csvへ一行書き込む
End If

↑こんな感じで､

buf = .Trim(buf) 'ここで､Bufから空白抜いて

If Len(buf) > 1 Then '1文字以上ならﾃﾞｰﾀありなので↓書き込む

buf = Replace(buf, " ", ",") 'ｽﾍﾟｰｽをｶﾝﾏにしてから

Print #1, buf 'ﾃｷｽﾄﾌｧｲﾙ csvへ一行書き込む

End If

素朴な疑問ですが､

A B C

1 青木太朗,2月,ﾒｰﾙ配信可,-

2 秋葉花子,2月,ﾒｰﾙ配信可,-

など､

氏名でｾｲとﾒｲの間にｽﾍﾟｰｽがあった時､

単純に

buf = Replace(buf, " ", ",") 'ｽﾍﾟｰｽをｶﾝﾏにしてから

Print #1, buf 'ﾃｷｽﾄﾌｧｲﾙ csvへ一行書き込む

だと､別問題が発生するような未来が見えるような､見えないような｡

名前にｽﾍﾟｰｽが入らなかったらｽﾐﾏｾﾝ､ｽﾙｰしてください｡

buf = .Trim(buf) '←あっ､ここで､Bufから空白抜いてるｼﾞｬﾝ､見落とした･･･
If Len(buf) > 1 Then '1文字以上ならﾃﾞｰﾀありにする？手抜きだけど 
 buf = Replace(buf, " ", ",") 'ｽﾍﾟｰｽをｶﾝﾏにしてから
 Print #1, buf 'ﾃｷｽﾄﾌｧｲﾙ csvへ一行書き込む
End If

で､動くといいなぁ････