Excel VBA質問箱 IV

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

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


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

73311 / 76732

←次へ　｜　前へ→


	【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

0 hits

▼

【7690】カンマ区切りのCSVで保存した時の改行を削除したいのですが。。。 でこぽんウマイ！ 03/9/11(木) 21:49