Excel VBA質問箱 IV

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

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


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

54293 / 76738

←次へ　｜　前へ→


	【27241】Re:csv中の英字をカットオフするには

awu - 05/8/3(水) 12:39 -


	引用なし

	パスワード

CSVファイルをシートに表示したくないようにも取れますが・・・
もし、そうであれば、新規ブックの標準モジュール等に下記コードを貼り付けて
実行すると、ご希望のファイル内容に書き換わると思います。

Sub CSV書換()
Dim FNum As Integer
Dim WNum As Integer
Dim N As Integer, Rw As Long
Dim FName, InData, Ary
Dim WName As String, OutData As String
FName = Application _
　　.GetOpenFilename("CSV ファイル(*.csv),*.csv", , "CSVファイルの指定")
If FName = False Then Exit Sub
N = InStrRev(FName, "\")
WName = Left(FName, N) & "Work" & Right(FName, Len(FName) - N)
FNum = FreeFile
Open FName For Input As FNum
WNum = FreeFile
Open WName For Output As WNum
Do Until EOF(FNum)
　　OutData = ""
　　Line Input #FNum, InData
　　Ary = Split(Trim(InData), ",")
　　If UBound(Ary) >= 16 Then
　　　　If Right(Ary(16), 1) = "M" Then
　　　　　　Ary(16) = Left(Ary(16), Len(Ary(16)) - 1)
　　　　End If
　　　　If UBound(Ary) < 19 Then
　　　　　　ReDim Preserve Ary(19)
　　　　End If
　　　　If Rw > 0 Then Ary(19) = Ary(16)
　　End If
　　For N = 0 To UBound(Ary)
　　　　OutData = OutData & Ary(N)
　　　　If N < UBound(Ary) Then OutData = OutData & ","
　　Next N
　　Print #WNum, OutData
　　Rw = Rw + 1
Loop
Close #WNum
Close #FNum
On Error Resume Next
FileCopy WName, FName
If Err.Number > 0 Then
　　MsgBox Err.Description & vbLf & vbLf & _
　　　　"指定のCSVファイルを閉じてから実行してください。", vbCritical
　　Exit Sub
End If
Kill WName
MsgBox "ファイルの修正完了 !!　（全行数 " & Rw & " 行） ", vbInformation
End Sub

0 hits

▼

【27224】csv中の英字をカットオフするには にしもり 05/8/2(火) 19:20