Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


12815 / 13644 ツリー ←次へ | 前へ→

【7690】カンマ区切りのCSVで保存した時の改行を削除したいのですが。。。 でこぽんウマイ! 03/9/11(木) 21:49 質問
【7706】Re:カンマ区切りのCSVで保存した時の改行を... Jaka 03/9/12(金) 14:11 回答
【7879】Re:カンマ区切りのCSVで保存した時の改行を... でこポンうまい!! 03/9/21(日) 23:41 質問
【7889】Re:カンマ区切りのCSVで保存した時の改行を... Jaka 03/9/22(月) 13:48 回答
【7891】Re:カンマ区切りのCSVで保存した時の改行を... BOTTA 03/9/22(月) 16:38 回答
【7901】Re:カンマ区切りのCSVで保存した時の改行を... ichinose 03/9/22(月) 23:46 回答
【8311】Re:カンマ区切りのCSVで保存した時の改行... でこぽんウマイ! 03/10/8(水) 11:25 発言
【8494】Re:カンマ区切りのCSVで保存した時の改行... でこぽんウマイ! 03/10/20(月) 14:29 お礼
【7904】Re:カンマ区切りのCSVで保存した時の改行を... Hirofumi 03/9/23(火) 8:58 発言
【8242】Re:カンマ区切りのCSVで保存した時の改行... でこポンうまい!! 03/10/6(月) 1:21 質問
【8324】Re:カンマ区切りのCSVで保存した時の改行... Hirofumi 03/10/8(水) 20:56 回答
【8326】Re:カンマ区切りのCSVで保存した時の改行... Hirofumi 03/10/8(水) 21:26 発言

【7690】カンマ区切りのCSVで保存した時の改行を削...
質問  でこぽんウマイ! E-MAIL  - 03/9/11(木) 21:49 -

引用なし
パスワード
   はじめまして。でこぽんウマイ!です。
宜しくお願いします。

EXELファイルをCSV形式で保存したら、なぜかデータが終わった1行下に改行が挿入されて保存されました。
マクロの都合上、改行コードはLFのみにしたいのですが、最終行に挿入されたその改行コードのみが、よりによってCR!

何とか最終行に勝手に挿入される改行コードを削除して保存できないでしょうか?
または、保存したファイルから最後の改行コードを抜き取る方法はないでしょうか?

わかる方がいましたら、ご教授下さい。

【7706】Re:カンマ区切りのCSVで保存した時の改行...
回答  Jaka  - 03/9/12(金) 14:11 -

引用なし
パスワード
   こんにちは。
ワードで開いて消せば良いんじゃないかと思いますけど..。

【7879】Re:カンマ区切りのCSVで保存した時の改行...
質問  でこポンうまい!! E-MAIL  - 03/9/21(日) 23:41 -

引用なし
パスワード
   ▼Jaka さん:
>こんにちは。
>ワードで開いて消せば良いんじゃないかと思いますけど..。

Jakaさん返答ありがとうございます!
旅行にいってましたので、返事が遅れて申し訳御座いません。

ワードで開いても変換はできるのですが、自動で変換はできないでしょうか?
ファイル名を指定して、行の終わりの改行をCRからLFに変換するような。。。

VBA経験が浅いので何ができて、何ができないのか判断できない状況ですが、
ご教授下さい。

【7889】Re:カンマ区切りのCSVで保存した時の改行...
回答  Jaka  - 03/9/22(月) 13:48 -

引用なし
パスワード
   こんにちは。
今一良く解っていないので突っ込まないで下さい。
特に
Mst2 = Mid(Mst, 1, Len(Mst) - 2) ← 何で-2なの?って。

'VBE → ツール → 参照設定 
'Microsoft Scripting Runtime にチェック。
Sub fffgy()
  Dim Fso As New Scripting.FileSystemObject
  Dim Txs As Scripting.TextStream
  Dim OPfl As String, Mst As String, Mst2 As String
  OPfl = Application.GetOpenFilename("CSVFile (*.csv), *.csv")
  If OPfl = "False" Then
    End
  End If
  Set Txs = Fso.OpenTextFile(OPfl, ForReading)
  Mst = Txs.ReadAll
  Txs.Close
  If Right(Mst, 1) = vbCr Or Right(Mst, 1) = vbLf Or Right(Mst, 1) = vbCrLf Then
    Mst2 = Mid(Mst, 1, Len(Mst) - 2)
    Set Txs = Fso.OpenTextFile(OPfl, ForWriting)
    Txs.Write Mst2
    Txs.Close
  End If
  Set Txs = Nothing
End Sub

【7891】Re:カンマ区切りのCSVで保存した時の改行...
回答  BOTTA  - 03/9/22(月) 16:38 -

引用なし
パスワード
   でこぽんウマイ!さん、Jakaさん、こんにちは。

Jakaさんのは、既に保存されたFileを変換しているようですネ。
私は、保存するときに処理する様にしてみました。
シートを直接保存ではなく、まずDataオブジェクトへ格納して、
String形式へ変換後、CSV形式へ変換、最終行のvbCrをvbLfへ変換。
最後にFileSystemObjectを使って、テキスト保存してます。
とっても回りくどいことをしているような気がします。
また、こちらにはCRとLFを区別できるエディタがないので結果を確認
出来ません。うまくいったらお知らせ下さい。

<注意>
Microsoft Forms 2.0 Object Libraryの参照設定が必要です。
VBE画面で「ツール」→「参照設定」でCheckを入れる。
見つからない場合は「参照」ボタンを押して、Systemフォルダ内の「FM20.DLL」
を選択して「開く」を押します。


Sub aaa()
Dim strData As String, objData As DataObject
Dim fso As Object, objText As Object, Fname As String
Dim i As Integer
  ActiveSheet.UsedRange.Copy
  Set objData = New DataObject
  'セルデータをDataオブジェクトへ格納
  objData.GetFromClipboard
  '↓Dataオブジェクトから文字列として取り出し
  strData = objData.GetText(1)
  '↓タブ区切→カンマ区切に変換
  strData = Replace(strData, vbTab, ",")
  '↓最後のvbCr文字位置を取得
  i = InStrRev(strData, vbCr)
  '↓最後のvbCr文字をvbLfへReplace
  strData = Left(strData, i - 1) & Replace(strData, vbCr, vbLf, i)
  '↓最後のvbCr文字を削除なら
  'strData = Left(strData, i - 1) & Replace(strData, vbCr, "", i)
  
  '↓FileSystemObject
  Fname = "C:\WINDOWS\デスクトップ\temp\test.csv" '←正しいファイル名にしてね
  Set fso = CreateObject("Scripting.FileSystemObject")
  '↓書き込み専用でOpen、無ければファイルを作成
  Set objText = fso.OpenTextFile(Fname, 2, True)
  '↓文字列を保存
  objText.Write strData
  objText.Close
  Set objText = Nothing: Set fso = Nothing: Set objData = Nothing
End Sub

【7901】Re:カンマ区切りのCSVで保存した時の改行...
回答  ichinose  - 03/9/22(月) 23:46 -

引用なし
パスワード
   こんばんは。
セルA1〜A5にa,b,c,d,eと入力したシートをcsv形式で保存しました。
ヘキサダンプを見ると、
61DA
62DA
63DA
64DA
65DA
66DA
となっていますが、これがコンバージョンで
61A
62A
63A
64A
65A
66A
となるようにしました。
'=============================================
Sub main()
  Dim flnm
  flnm = Application.GetOpenFilename()
  If flnm <> False Then
    Call コンバージョン_Crなし(flnm)
    End If
End Sub
'=============================================
Sub コンバージョン_Crなし(flnm)
  Dim flno1 As Long
  Dim flno2 As Long
  Dim bt() As Byte
  Dim bta() As Byte
  path = CreateObject("Scripting.FileSystemObject").GetParentFolderName(flnm)
  On Error Resume Next
  Kill path & "\temp.tmp"
  On Error GoTo 0
  If open_fl(flno1, flnm) = 0 And open_fl(flno2, path & "\temp.tmp") = 0 Then
    If get_fl(flno1, bt()) = 0 Then
     jdx = 0
     For idx = LBound(bt()) To UBound(bt())
       If bt(idx) <> &HD Then
        ReDim Preserve bta(jdx)
        bta(jdx) = bt(idx)
        jdx = jdx + 1
        End If
       Next
     If put_fl(flno2, bta()) <> 0 Then Stop
     Call cls_fl(flno1)
     Call cls_fl(flno2)
     Kill flnm
     Name path & "\temp.tmp" As flnm
     End If
    Call cls_fl(flno1)
    Call cls_fl(flno2)
    End If
End Sub
'====================================================
Function open_fl(flno As Long, flnm) As Long
  On Error Resume Next
  flno = FreeFile()
  Open flnm For Binary As #flno
  open_fl = Err.Number
  On Error GoTo 0
End Function
'====================================================
Sub cls_fl(flno As Long)
  On Error Resume Next
  Close #flno
  On Error GoTo 0
End Sub
'=======================================================
Function get_fl(ByVal flno As Long, bt() As Byte) As Long
  On Error Resume Next
  ReDim bt(LOF(flno) - 1)
  Get #flno, , bt()
  get_fl = Err.Number
  On Error GoTo 0
End Function
'=======================================================
Function put_fl(flno As Long, bt() As Byte) As Long
  On Error Resume Next
  Put #flno, , bt()
  put_fl = Err.Number
  On Error GoTo 0
End Function

のmainを実行してみて下さい。上記のようになりました。

ちなみに、ヘキサダンプは以下のコードで確認しました。
'=================================================
Sub disp_fl_dump()
  Cells(1, 1).Value = dump()
End Sub
'=================================================
Function dump() As String
  Dim buf As String
  Dim bt() As Byte
  Dim flno As Long
  Dim flnm
  flnm = Application.GetOpenFilename()
  If flnm <> False Then
    If open_fl(flno, flnm) = 0 Then
     If get_fl(flno, bt()) = 0 Then
       dump = ""
       For idx = LBound(bt()) To UBound(bt())
        dump = dump & Hex(bt(idx))
        Next idx
       End If
     Call cls_fl(flno)
     End If
    End If
End Function

【7904】Re:カンマ区切りのCSVで保存した時の改行...
発言  Hirofumi E-MAIL  - 03/9/23(火) 8:58 -

引用なし
パスワード
   横から失礼します
でこぽんウマイさん、これを見ていてチョット気になる事が有るのですが?
間違っていたらゴメンナサイ

>EXELファイルをCSV形式で保存したら、なぜかデータが終わった1行下に
>改行が挿入されて保存されました。
>マクロの都合上、改行コードはLFのみにしたいのですが、
>最終行に挿入されたその改行コードのみが、よりによってCR!

と有るのですが、ExcelってSaveAs等で、改行コードを選んでCSV出力出来ましたっけ?
出来ないと成ると、VBAでCSV出力のコードを組んでませんか?
そうすると、そのコードがおかしいのでは?

また、最終レコードがLfで終わっても、WordやEditorでは、
>なぜかデータが終わった1行下に改行が挿入されて保存されました。
の状態に成りますが?

実際にCSV出力したコードをUpされてはどうでしょうか?

【8242】Re:カンマ区切りのCSVで保存した時の改行...
質問  でこポンうまい!! E-MAIL  - 03/10/6(月) 1:21 -

引用なし
パスワード
   ▼Hirofumi さん:
お返事有難う御座います!
VBは殆どわからないもので、変な書き方で伝わりにくいかも知れませんが
宜しくお願い致します。

>ExcelってSaveAs等で、改行コードを選んでCSV出力出来ましたっけ?
>出来ないと成ると、VBAでCSV出力のコードを組んでませんか?

改行コードを選んでCSV出力をできるかわかりませんが、確かにVBAで以下の様に書いてます。
---------------------------------------------------------------------
Activesheet.SaveAs Filename:="新しいファイル.csv", _
FileFormat:=xlCSV , CreateBackup:=False
---------------------------------------------------------------------


>また、最終レコードがLfで終わっても、WordやEditorでは、
>>なぜかデータが終わった1行下に改行が挿入されて保存されました。
>の状態に成りますが?
>
>実際にCSV出力したコードをUpされてはどうでしょうか?

実際のCSV出力したコードは非常に長いのでUpはできませんが、以下の様にループを組んでます。ループ内は基本的に代入処理しか行っていません。
-------------------------------------------------------------
Do While Range("A1").Offset(row_cnt,0)<>""
  Sheets(2).Range("D3").Offset(row_count,0).Value = _
  Sheets(1).Range("A1").Offset(row_count,0).Value
  row_cnt=row_cnt+1
Loop
-------------------------------------------------------------

改行を変数で行っている事に問題があるのでしょうか?
それとも、保存の方法に問題があるのでしょうか?
初心者で恐縮ですが、回答お願い致します。

【8311】Re:カンマ区切りのCSVで保存した時の改行...
発言  でこぽんウマイ! E-MAIL  - 03/10/8(水) 11:25 -

引用なし
パスワード
   To:Jaka様、BOTTA様、ichinose様

お返事有難う御座います!でこぽんウマい!です。
現在、各ソースを解読&検証中です。
どれも初心者の私には理解に時間が掛かりますのでもう少しお時間下さい!
わからない点は再度御質問させて頂きますので、宜しくお願い致します。

【8324】Re:カンマ区切りのCSVで保存した時の改行...
回答  Hirofumi E-MAIL  - 03/10/8(水) 20:56 -

引用なし
パスワード
   何か、肝心な部分が書かれて居ないので、善く説明が解らないのですが?
よって、私が使っているCSV出力のコードを載せて置きます

以下のコードは、シートの決められた列数を最終行までCSV出力します
提示したコードは、ActiveSheetをLfを改行コードとし、先頭から15列出力します
もし、シート、列数等を変更したい場合は、以下の数値等を変更して下さい

  'ファイル出力するシートの参照
  Set wksRead = ActiveSheet
  'ファイル出力する先頭行の値
  lngReadRow = 1
  'ファイル出力する先頭列の値
  lngReadCol = 1
  'ファイル出力する最終列の値
  lngReadCalEnd = 15

'以下を標準モジュールに記述して下さい

Option Explicit

Public Sub WriteCsvSequ()

  Dim vntFileName As Variant
  Dim wksRead As Worksheet
  Dim lngReadRow As Long
  Dim lngReadCol As Long
  Dim lngReadCalEnd As Long
  
  '出力名を取得します
  If Not GetWriteFile(vntFileName, ThisWorkbook.Path) Then
    Exit Sub
  End If
  
  'ファイル出力するシートの参照
  Set wksRead = ActiveSheet
  'ファイル出力する先頭行の値
  lngReadRow = 1
  'ファイル出力する先頭列の値
  lngReadCol = 1
  'ファイル出力する最終列の値
  lngReadCalEnd = 15
  
  'ファイルに出力
  CsvWrite vntFileName, vbLf, wksRead, _
          lngReadRow, lngReadCol, lngReadCalEnd
  
  '読み込むシートの参照を破棄
  Set wksRead = Nothing
  
  Beep
  MsgBox "処理が終了しました", vbOKOnly, "終了"

End Sub

Private Sub CsvWrite(ByVal strFileName As String, _
            strRetCode As String, _
            ByVal wksRead As Worksheet, _
            lngRowTop As Long, _
            lngColTop As Long, _
            lngColEnd As Long)

  Dim dfn As Integer
  Dim i As Long
  Dim j As Long
  Dim lngRowEnd As Long
  Dim strBuf As String
  Dim vntField As Variant
  
  
  '読み込み最終行を取得
  With wksRead
    lngRowEnd = .Cells(65536, lngColTop).End(xlUp).Row
  End With
  
  '空きファイル番号を取得します
  dfn = FreeFile
  '出力ファイルをOpenします
  Open strFileName For Output As dfn
    
  With wksRead.Cells(lngRowTop, lngColTop)
    For i = 0 To lngRowEnd - lngRowTop
      '1行分のDataをシートから読みこむ
      vntField = Range(.Offset(i), _
                .Offset(i, lngColEnd - 1)).Value
      '出力1レコード作成
      strBuf = ComposeLine(vntField, ",") & strRetCode
      '1レコード書き出し
      Print #dfn, strBuf;
    Next i
  End With
  
  '出力ファイルを閉じる
  Close #dfn
  
End Sub

Private Function ComposeLine(vntField As Variant, _
          Optional strDelim As String = ",") As String

'  出力レコードの作成

  Dim i As Long
  Dim strResult As String
  Dim lngFieldEnd As Long
  
  lngFieldEnd = UBound(vntField, 2)
  For i = 1 To lngFieldEnd
    strResult = strResult & PrepareCsvField(vntField(1, i))
    If i < lngFieldEnd Then
      strResult = strResult & strDelim
    End If
  Next i
  
  ComposeLine = strResult
  
End Function

Private Function PrepareCsvField(ByVal _
              strValue As String) As String

'  フィールドのダブルクォーツ付加

  Dim i As Long
  Dim blnQuot As Boolean
  Dim lngPos As Long
  Const strQuot As String = """"
  
  If Left(strValue, 1) = "'" Then
    strValue = Mid(strValue, 2)
  End If
  
  i = 1
  lngPos = InStr(i, strValue, strQuot, vbBinaryCompare)
  Do Until lngPos = 0
    strValue = Left(strValue, lngPos) _
              & Mid(strValue, lngPos + 1)
    i = lngPos + 2
    lngPos = InStr(i, strValue, strQuot, vbBinaryCompare)
  Loop
    
  For i = 1 To 5
    lngPos = InStr(1, strValue, Choose(i, ",", strQuot, _
              vbCr, vbLf, vbTab), vbBinaryCompare)
    If lngPos <> 0 Then
      blnQuot = True
      Exit For
    End If
  Next i
  
  If blnQuot Then
    strValue = strQuot & strValue & strQuot
  End If
  
  PrepareCsvField = strValue

End Function

Private Function GetWriteFile(vntFileName As Variant, _
          Optional strFilePath As String) As Boolean

  Dim i As Long
  Dim strFilter As String
  Dim strInitialFile As String
  
  'フィルタ文字列を作成
  For i = 1 To 2
    strFilter _
      = strFilter & Choose(i, "CSV File (*.csv),*.csv,", _
                  "Text File (*.txt),*.txt")
  Next i
  
  '既定値のファイル名を設定
  strInitialFile = vntFileName
  
  '読み込むファイルの有るフォルダを指定
  If strFilePath <> "" Then
    'ファイルを開くダイアログ表示ホルダに移動
    ChDrive Left(strFilePath, 1)
    ChDir strFilePath
  End If
  
  vntFileName _
    = Application.GetSaveAsFilename(vntFileName, strFilter, 1)
  If vntFileName = False Then
    Exit Function
  End If

  GetWriteFile = True
  
End Function

【8326】Re:カンマ区切りのCSVで保存した時の改行...
発言  Hirofumi E-MAIL  - 03/10/8(水) 21:26 -

引用なし
パスワード
   ゴメン一部、意味がアヤフヤ部分がありました

  'ファイル出力する先頭列の値
  lngReadCol = 1

1とは、A列を指します、当然、B列なら2として下さい

  'ファイル出力する最終列の値
  lngReadCalEnd = 15

と有りますが、これは「最終列の値」では無く列数の間違いです

詰まり、上記はA列から15列(O列)迄を出力すると言う意味です

【8494】Re:カンマ区切りのCSVで保存した時の改行...
お礼  でこぽんウマイ! E-MAIL  - 03/10/20(月) 14:29 -

引用なし
パスワード
   でこぽんウマイ!です。
To:Jaka様、BOTTA様、ichinose様

ありがとう御座いました。全部の方法を試し、成功致しました。
そして、ようやくVBプログラム作成の感覚が掴めてきました。
また、何か不明な点が有った際は宜しくお願いします!

12815 / 13644 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free