| |
On Error GoTo ErrorTrap
Sheets("download.csv").Select
Cells.Select
Rows("2:1000").Select
'Selection.Delete Shift:=xlUp
fname = Application.GetOpenFilename(FileFilter:="CSVファイル(*.csv),*.csv", FilterIndex:=1, Title:="ファイル選択 download.csv", MultiSelect:=False)
If StrConv(fname, vbUpperCase) = "FALSE" Then Exit Sub
'空いているファイル番号を取得します
ch1 = FreeFile
'FileNamePath のファイルをオープンします
Open fname For Input As #ch1
Worksheets("download.csv").Activate
Worksheets("download.csv").Columns("A:AX").NumberFormat = "@"
Rowcnt = 1
With Worksheets("download.csv")
Do While Not EOF(ch1) 'ファイルの終端かどうかを確認します。
'1行読み込みます
Line Input #ch1, textline
textline = Replace(textline, vbLf, vbCrLf)
'textline = Replace(textline, vbLf, ",")
ipos0 = 1
For i = 1 To 35
ipos1 = InStr(ipos0, textline, """")
ipos2 = InStr(ipos1 + 1, textline, """")
If ((ipos1 <> 0) And (ipos2 <> 0) And (ipos2 > ipos1)) Then
For j = ipos1 + 1 To ipos2 - 1
If (Mid(textline, j, 1) = ",") Then
Mid(textline, j, 1) = vbTab
End If
Next j
Else
Exit For
End If
ipos0 = ipos2 + 1
Next i
'カンマで分離します
csvline() = Split(textline, ",")
ix = UBound(csvline())
For i = 1 To ix
csvline(i) = Replace(csvline(i), vbTab, ",")
Next i
Rowcnt = Rowcnt + 1
'配列渡しでセルに代入
Range(Cells(Rowcnt, 1), Cells(Rowcnt, UBound(csvline()) + 1)) = csvline()
Loop
End With
Close #ch1
Worksheets("download.csv").Columns("A:AX").EntireColumn.AutoFit
MsgBox "ファイルの読込み完了しました。" & vbCrLf & fname
Exit Sub
ErrorTrap:
MsgBox "データにエラーがあります。"
Exit Sub
End Sub
100行のでーたが入っているCSVファイルを読み込み、行ごとに読み込んでEXCELに書きだして編集できるようにと思っているのですが、失敗する場合と、成功する場合があるのでどこをどうしたらいいかわからないので
よければ教えて欲しいです。持っているファイルをterapadで開いて保存しなおす時、失敗するときは改行コードがvbLfで、成功するときは改行コードをvbCr+vbLfで保存しなおすと改行ごとに読み込めます。
保存できるファイルの改行コードがvbLf固定で、一回開いて保存が大変なのでなるべくなら
EXCELVBAフォームのボタンクリック→ファイル選択→EXCELに書き出しがやりたいです。
文字形式は、SHIFT-JISです。
|
|
たつのこ
- 11/8/3(水) 15:34 -
