マクロでセル内の改行を削除する方法

質問

システムから抽出したCSVファイルをExcelで読み込むと同時に不要な列を削除します。

その際、セル内の改行が邪魔で行がずれてしまいます。

すでに記述したコードを生かしながら、セル内の改行を削除する方法はありますでしょうか？

以下がコードです

Private Sub CommandButton1_Click()

'//Sheet7のセルをクリア
Sheets("Sheet7").Cells.Clear

'// Sheet7のA1にissue_export.csvを読み込み
With Sheets("Sheet7").QueryTables.Add(Connection:="TEXT;C:\*****.csv", Destination:=Sheets("sheet7").Range("A1"))

Dim R As Range
For Each R In Sheets("Sheet7").Range("A1")
R.Value = Trim(Replace(R.Value, vbCr, ""))
R.Value = Trim(Replace(R.Value, vbLf, ""))
Next R

.Name = "test"
.FieldNames = True
.RowNumbers = False
.Refresh BackgroundQuery:=False
.RefreshPeriod = 0
.RefreshOnFileOpen = False
.PreserveFormatting = True
.AdjustColumnWidth = True
.FillAdjacentFormulas = False
.RefreshStyle = xlInsertEntireRows
.SavePassword = False
.SaveData = True
.TextFilePromptOnRefresh = False
.TextFileParseType = xlDelimited
.TextFileStartRow = 1
.TextFilePlatform = 65001
.TextFilePlatform = xlWindows
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = True
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
.TextFileTrailingMinusNumbers = False

.TextFileColumnDataTypes = Array(9, 9, 9, 9, 2, 9, 2, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 2, 2, 2, 9, 2, 2, 2, 2, 2, 2, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9)

.Refresh
.Parent.Names(.Name).Delete
.Delete
End With

End Sub

回答No.1

end-u · ベストアンサー

1)QueryTableではなく[ファイル]-[開く]Openメソッドで通常に開くとセル内改行で処理されるか。
2)セル内改行・・フィールド内改行が含まれているデータは""ダブルクォートで囲まれているか。
　ex)・・,"A（改行）B（改行）C",・・
3)他に、セル内に『,』が含まれているデータはあるか。また、それは""ダブルクォート囲みか。
　ex)・・,"1,234",・・
4)CSVファイルのデータ量はどれくらいか。
　ex)y行×x列
5)『すでに記述したコードを生か』す事は必須条件か。

上記の確認事項の結果次第でアドバイスが変わります。
(1)yes なら、簡単な方法として
Workbooks.Openメソッドで別ファイルで開き必要なデータをコピーペーストする案が考えられます。
この時Application.ScreenUpdatingを制御して開いている事を意識させないようにします。
『すでに記述したコードを生か』さなくても良いならこの方法が最も素直な処理です。

(4)が必須だと、QueryTableで取り込む前に、テキストベースで一旦開き、改行文字をスペースなどにReplaceして保存し、
あらためてQueryTableでの取り込みを実行するようにします。
過去、同様な事例を参考にしてみてください。
http://okwave.jp/qa/q5972724.html?order=asc
# このケースでは必要データが２行×２ファイルなので、改行文字Replace＆QueryTable はオーバースペックで、
# 素直にOpenメソッドを使ったほうが良いケースでしたが。

(1),(2)ともnoだと、ちょっと難易度が上がりますね。
その時はダミーで良いのでサンプルのデータがあるほうがアドバイスし易いです。

補足

上記アドバイスありがとうございます。

まずは（１）から試したいと思うのですが、なにぶん初心者なもので記述の仕方がわかりません。

私が書いたソースのどこを変更すれば良いか、アドバイスを頂けませんでしょうか。お手数をおかけして申し訳ございません

回答No.4

end-u

そもそもの案件と全く違う内容の質問を補足欄でだらだらと続けられても困惑します。
勿論こちらに応える義務はないとは言え。
しかもその追加内容に誤りがあったり、断片的な情報しか提示されないなら
有効なアドバイスは難しいです。

>Range("C6").Value = Evaluate("SUMPRODUCT((Sheet7!A2:A3204=B6)*(Sheet7!K2:K3204=K16))")
このコードがシートモジュールに置いたコードなら、
『Range("C6")』、『B6』、『K16』はそのシートのセルを参照します。
標準モジュールに書いてあれば、コード実行時のActiveSheetを参照します。
処理が複数シートにまたがっているのなら、そういった参照関係に気をつけてください。
どちらにしても紛れがないのは
例えば
Sheets("Sheet1").Range("C6").Value = Evaluate("SUMPRODUCT((Sheet7!A2:A3204=Sheet1!B6)*(Sheet7!K2:K3204=Sheet1!K16))")
..などとSheetを明示する事です。

回答No.3

end-u

ゃ？
With Sheets("Sheet7")
　　Range("F6").Value = WorksheetFunction.CountIf(.Range("A2:A3000"), .Range("A6"))
End With
普通にCountIf関数で良いと思われるのですけれども。

補足

すみません、ご迷惑ばかりで…。

確かに、お書き頂いた上記の方法でカウントできました。
しかしながら…。

複数条件でカウントしたいのです。

なので、sumproductではないかと。

With Sheets("Sheet7")
Range("C6").Value = Evaluate("SUMPRODUCT((Sheet7!A2:A3204=B6)*(Sheet7!K2:K3204=K16))")
End With

B6がトマトだとして、K１６が大（大きさ）だとします。
ちなみに、上記ではきちんとカウントされませんでした。

すみません、最後のお力添えを頂けないでしょうか。

回答No.2

end-u

(1)を言い換えると。
手作業でExcelメニューの[ファイル]-[開く]から目的のCSVファイルを開いた場合、
セル内改行はセル内改行のままで開いて、列がずれたりしませんか？
確認してください。

もし、ずれる事なく正常に開く事ができるなら、
>Workbooks.Openメソッドで別ファイルで開き必要なデータをコピーペーストする案が考えられます。

コード化については、
上記作業をマクロ記録してみてください。

Sub Macro1()
'
' Macro1 Macro
' マクロ記録日 : 2012/10/18 ユーザー名 : end-u
'

'
　　Cells.Select
　　Selection.ClearContents
　　Workbooks.Open Filename:="C:\issue_export.csv"
　　Range("E:E,G:G,R:T,V:AA").Select
　　Range("V1").Activate
　　Selection.Copy
　　Windows("issue_export.xls").Activate
　　Range("A1").Select
　　ActiveSheet.Paste
　　Application.CutCopyMode = False
　　Windows("issue_export.csv").Activate
　　ActiveWindow.Close
End Sub

..のようなものが録れるはずです。
これをブラッシュアップして以下のように修正します。

Sub try()
　　Dim ws As Worksheet

　　Application.ScreenUpdating = False
　　Set ws = ThisWorkbook.Sheets("Sheet7")
　　ws.UsedRange.Clear
　　With Workbooks.Open(Filename:="C:\issue_export.csv")
　　　　.Sheets(1).Range("E:E,G:G,R:T,V:AA").Copy ws.Range("A1")
　　　　.Close savechanges:=False
　　End With
　　Application.ScreenUpdating = True
End Sub

# ついでに。
# >(4)が必須だと、QueryTableで取り込む前に、...
# (5)が必須だと、...の間違いでしたorz

補足

ありがとうございます。
上記の記述で問題なくインポートできました。

実はそこから集計を取りたいと考えておりまして…

例えば、A列にある「トマト」というキーワードが何個あるかを集計しようとします。

Private Sub CommandButton1_Click()
Dim ws As Worksheet

Application.ScreenUpdating = False
Set ws = ThisWorkbook.Sheets("Sheet7")
ws.UsedRange.Clear
With Workbooks.Open(Filename:="C:\issue_export.csv")
.Sheets(1).Range("E:E,G:G,R:T,V:AA").Copy ws.Range("A1")
.Close savechanges:=False
End With
Application.ScreenUpdating = True

End Sub

Private Sub CommandButton2_Click()

Range("F6").Value = Evaluate("SUMPRODUCT((Sheet7!$A$2:$A$3000=Sheet7!$A$6)")
End Sub

※A6がトマトだとします

上記ですと、#VALUE!と返ってきてしまします。

大変申し訳ございませんが、ご教示いただけますと幸いです。