いけず言葉しりとり

エクセルのデータをタブ区切りで出力したいのですが、「ファイル名を付けて保存」から「ファイルの種類」をタブ区切りにして保存した場合、カンマが含まれるセルにダブルクォーテーション「””」が付与されてしまいます。

やりたいことは以下の3つになります。
1.タブ区切りで出力する
2.カンマが含まれていてもダブルクォーテーションで括らない
3.先頭2行(1行目と2行目)を削除
※1行目はタイトル行、2行目はサンプル行です。

1と2を満たすVBAはできたのですが、3を実現するために以下の
処理を加えたところ、正しくタブ区切りで出力されなくなってしまいました。
・アクティブシートをコピー
・1~2行目を削除
・コピーしたシートを削除


作成したVBAは以下になります。

ーーーーーーーここからーーーーーーーーーーーー

Option Explicit


Public Sub ChangeTSV()
Dim FileName As String
FileName = WriteTsvFile(ActiveSheet)
If FileName <> "" Then
MsgBox "タブ区切りテキストファイルが作成されました。" & vbCrLf & "[PATH]" & vbCrLf & FileName, vbInformation, "タブ区切りテキストファイル作成完了"
End If
End Sub


Private Function WriteTsvFile(TargetSheet As Worksheet) As String
On Error GoTo WriteTabTxtFileErr

Dim FileName As String
Dim LastRow As Long
Dim LastCol As Long
Dim レコード As String
Dim c As Variant
Dim i As Long
Dim FileNo As Integer

' アクティブシートをコピー
ActiveSheet.Copy After:=Worksheets("最後のシート名")

' 1~2行目を削除
Range("1:2").Delete

' ファイル名を作成
FileName = Application.ThisWorkbook.Path & "\" & TargetSheet.Name & "_" & Format(Now, "yyyymmdd-hhmmss") & ".txt"
FileNo = FreeFile()

' 最終行と最終列の取得
LastRow = Cells(Rows.Count, 1).End(xlUp).Row
LastCol = Cells(1, Columns.Count).End(xlToLeft).Column

i = 1

Open FileName For Output As #FileNo

' アラートOFF
Application.DisplayAlerts = False

Do Until i > LastRow
For Each c In Cells(i, 1).Resize(, LastCol)
レコード = レコード & vbTab & c.Value
Next c
Print #FileNo, Mid$(レコード, 2)
レコード = ""
i = i + 1
Loop
Close #FileNo

' コピーしたシートを削除
ActiveSheet.Delete

' アラートON
Application.DisplayAlerts = True

WriteTsvFile = FileName
Exit Function

WriteTabTxtFileErr:
MsgBox "[WriteTabTxtFile]" & vbCrLf & TargetSheet.Name & vbCrLf & Err.Description, vbCritical, "Exception"
WriteTsvFile = ""
Exit Function
End Function

ーーーーーーーここまでーーーーーーーーーーーー

タイトル行およびサンプル行を削除してから処理を行っているため、
どこまでがデータが入るべき列なのか判断できずに空白列にタブが入らないのは当たり前なのですが、
これを回避する方法がまったくわからず困っております。

お知恵をお貸しください。

A 回答 (1件)

1行目•2行目をDeleteせずにおいて、i=3から始めたらどうでしょう。

    • good
    • 0
この回答へのお礼

大きな修正もなく、期待通りの動きになりました。

勉強になりました。
本当にありがとうございました。

お礼日時:2014/11/28 10:00

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

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


おすすめ情報