accessVBAで特定の文字列を削除

質問

以前頼んで作ってもらったVBAを少し改造しようと思っていますが、上手くいきませんので質問します。よろしくお願いします。
csvファイルを分割するVBAを作ってもらいました。
1001,a12345678
1001,b15467863546789
1001,b25463254875698
1001,c23564879
1005,a23456753
1005,b25647565823653
1005,c26546875
1007,a23456789
1007,b23659856325632
1007,b46785215468523
1007,c12546873
というcsvファイルを
1001.csvというファイルで中身は
1001,a12345678
1001,b15467863546789
1001,b25463254875698
1001,c23564879
と
1005.csvというファイルで中身は、
1005,a23456753
1005,b25647565823653
1005,c26546875
と
1007.csvというファイルで中身は、
1007,a23456789
1007,b23659856325632
1007,b46785215468523
1007,c12546873
の3つのcsvファイルに分けます。
今回は仕様変更で、
1001.csvというファイルで中身は
a12345678
b15467863546789
b25463254875698
c23564879
と
1005.csvというファイルで中身は、
a23456753
b25647565823653
c26546875
と
1007.csvというファイルで中身は、
a23456789
b23659856325632
b46785215468523
c12546873
の3つに分けなくてはならなくなりました。

今使っているVBAは
Private Sub DOQUERY_Click()
Dim IN_FNO As Integer
Dim OUT_FNO As Integer
Dim BREAK_OLD As String
Dim BREAK_NEW As String
Dim HEADLINE As String
Dim TEXTLINE As String
Dim ARY() As String
Dim OUTNAME As String
Dim ARYNAME() As String
Dim CNT As Integer
Dim MSG As String
'============================================
On Error GoTo err
If IsNull(InputFile) Or IsNull(OutputFile) Then
Exit Sub
End If
If InputFile = "" Or OutputFile = "" Then
MsgBox "ファイル名が正しく指定されていません。", vbCritical
Exit Sub
End If
ラベル5.Visible = True
DoEvents
'読込みＣＳＶ　ＯＰＥＮ
IN_FNO = FreeFile
Open InputFile For Input As #IN_FNO
'見出し読込み
Line Input #IN_FNO, HEADLINE$
'１レコード目読込み
Line Input #IN_FNO, TEXTLINE$
'発注番号
ARY() = Split(TEXTLINE$, ",")
BREAK_NEW = Replace(ARY(0), """", "")
BREAK_OLD = BREAK_NEW
'出力ＣＳＶファイル名作成
OUTNAME = OutputFile & BREAK_NEW & ".csv"
'出力ＣＳＶファイル名保存
CNT = 1
ReDim Preserve ARYNAME(CNT)
ARYNAME(CNT) = OUTNAME
'出力ＣＳＶ　ＯＰＥＮ
OUT_FNO = FreeFile
Open OUTNAME For Output As #OUT_FNO
'見出し書込み
Print #IN_FNO, HEADLINE$
'１レコード目書込み
Print #IN_FNO, TEXTLINE$
Do While Not EOF(IN_FNO)
'次レコード目読込み
Line Input #IN_FNO, TEXTLINE$
'発注番号
ARY() = Split(TEXTLINE$, ",")
BREAK_NEW = Replace(ARY(0), """", "")
'発注番号が変わったとき新しいＣＳＶを開く
If BREAK_OLD <> BREAK_NEW Then
CNT = CNT + 1
BREAK_OLD = BREAK_NEW
'旧書込みＣＳＶをクローズ
Close #OUT_FNO
'新出力ＣＳＶファイル名作成
OUTNAME = OutputFile & BREAK_NEW & ".csv"
'新出力ＣＳＶファイル名保存
ReDim Preserve ARYNAME(CNT)
ARYNAME(CNT) = OUTNAME
'新出力ＣＳＶ　ＯＰＥＮ
OUT_FNO = FreeFile
Open OUTNAME For Output As #OUT_FNO
End If
'次レコード書込み
Print #OUT_FNO, TEXTLINE$
Loop
'出力ＣＳＶクローズ
Close #OUT_FNO
'入力ＣＳＶクローズ
Close #IN_FNO
'出力したＣＳＶ名称一覧
Dim I As Integer
For I = 1 To UBound(ARYNAME())
MSG = MSG & ARYNAME(I) & vbCrLf
Next
MsgBox CNT & "個のファイルに分割しました。" & vbCrLf + vbCrLf & MSG, vbInformation, "ＣＳＶ分割"
ラベル5.Visible = False
Exit Sub
err:
MsgBox err.Description, vbCritical, "エラー"
ラベル5.Visible = False
End Sub

です。

ファイル名がBREAK_NEWでそれを消せればいいと思うのですが・・・

以上長くなりましたが、よろしくお願いします。

回答No.1

noname#140971 · ベストアンサー

1001,a12345678-------->1001.csv
1001,b15467863546789-->1001.csv
1001,b25463254875698-->1001.csv
1001,c23564879-------->1001.csv
1005,a23456753-------->1005.csv
1005,b25647565823653-->1005.csv
1005,c26546875-------->1005.csv
1007,a23456789-------->1007.csv
1007,b23659856325632-->1007.csv
1007,b46785215468523-->1007.csv
1007,c12546873-------->1007.csv

と、いう感じですかね。

Private Sub コマンド0_Click()
　　Dim I　　　　　　　As Integer
　　Dim N　　　　　　　As Integer
　　Dim strDatas()　　 As String
　　Dim strNewDatas　　As String
　　Dim strNewFileName As String
　　Dim strNowFileName As String

　　strDatas() = FileReadArray("C:\Temp\Test.csv")
　　N = UBound(strDatas())
　　For I = 0 To N
　　　　If CharCount((strDatas(I)), ",") = 1 Then
　　　　　　strNewFileName = CutStr(strDatas(I), ",", 1)
　　　　　　If strNewFileName <> strNowFileName Then
　　　　　　　　If Len(strNowFileName & "") Then
　　　　　　　　　　FileWrite "C:\Temp\" & strNowFileName & ".csv", strNewDatas
　　　　　　　　End If
　　　　　　　　strNewDatas = CutStr(strDatas(I), ",", 2) & vbCrLf
　　　　　　　　strNowFileName = strNewFileName
　　　　　　Else
　　　　　　　　strNewDatas = strNewDatas & CutStr(strDatas(I), ",", 2) & vbCrLf
　　　　　　End If
　　　　End If
　　Next I
　　FileWrite "C:\Temp\" & strNowFileName & ".csv", strNewDatas
End Sub

FileSystemObject を利用すると、こんな感じになります。
多分、以下の解説を読むまでもなく理解できると思います。

strDatas() = FileReadArray("C:\Temp\Test.csv")　<--- 配列に呼び込む
N = UBound(strDatas())<----------------------------- 配列の数を調べる
For I = 0 To N<------------------------------------- 配列をループで調査・処理
Next I
If CharCount((strDatas(I)), ",") = 1 Then　<-------- 呼び込んだデータが処理対象か調べる
strNewFileName = CutStr(strDatas(I), ",", 1)<------- ファイルネームを切り取る
If strNewFileName <> strNowFileName Then <---------- ファイル名が切り替わったら書き込み処理
Else
End If
FileWrite "C:\Temp\" & strNowFileName & ".csv", strNewDatas<--- 書き込み処理
strNewDatas = CutStr(strDatas(I), ",", 2) & vbCrLf <-----------書き込みデータを初期化し先頭を代入
strNewDatas = strNewDatas & CutStr(strDatas(I), ",", 2) & vbCrLf<-----書き込みデータをアペンド。

Public Function CutStr(ByVal Text As String, _
　　　　　　　　　　　 ByVal Separator As String, _
　　　　　　　　　　　 ByVal N As Integer) As String
　　Dim strDatas() As String

　　strDatas = Split("" & Separator & Text, Separator, , 0)
　　CutStr = strDatas(N * Abs((N <= UBound(strDatas))))
End Function

Public Function CharCount(ByVal Text As String, ByVal C As String) As Integer
　　CharCount = Len(Text) - Len(Replace(Text, C, ""))
End Function

さて、FileReadArray()、FileWrite()ですが、これは長くなるので別途補足します。
先ずは、ここまで。

回答No.3

redfox63

BREAK_NEWでは対処不能でしょう

変数宣言を
dim ss as string, sHead() as String
Dim sBreakNew() as String, sBreakOld as String

ファイルの分割部分を

Open InputFile For Input As #IN_FNO
　　'見出し読込み
　　Line Input #IN_FNO, ss
　　' 見出しを分割
　　sHead = Split( ss, ",")

　　'１レコード目読込み
　　' Line Input #IN_FNO, TEXTLINE$
　　Cnt = -1
　　OUT_FNO = -1
　　sBreakOld = ""

　　do Until Eof( IN_FNO )
　　　　line Input #IN_FNO, ss
　　　　if InStr( ss, "," ) then
　　　　　　' 1レコードを分割
　　　　　　sBreakNew = Split( ss, "," )
　　　　　　sBreak(0) = Replace( sBreakNew(0), """", "" )
　　　　　　' 出力ファイルの切り替えを判断
　　　　　　if sBreakOld <> sBreakNew(0) then
　　　　　　　　' 出力ファイルを開いていれば閉じる
　　　　　　　　if OUT_FNO<>-1 then Close #OUT_FNO
　　　　　　　　OUT_FNO = FREEFILE
　　　　　　　　Open sBreakNew(0) & ".csv" for output as #OUT_FNO
　　　　　　　　'　見出し出力
　　　　　　　　priint #OUT_FNO, sHead(1)
　　　　　　　　' ファイル名更新
　　　　　　　　sBreakOld = sBreakNew(0)
　　　　　　　　cnt = cnt + 1
　　　　　　　　Redim Preserve ARYNAME(CNT)
　　　　　　　　ARYNAME( cnt ) = sBreakOld
　　　　　　end if
　　　　　　' データの出力
　　　　　　Print #OUT_FNO, sBreakNew(1)
　　　　end if
　　Loop
　　' 開いたファイルすべて閉じる
　　Close

　　MsgBox CNT & "個のファイルに分割しました。" & vbCrLf + vbCrLf & JOIN( ARYNAME, vbcrlf), vbInformation, "ＣＳＶ分割"

といった具合でしょう

お礼

変数を２つに分ければ良かったんですね。
今やった限りではところどころでエラーが出て、まだ完全ではありませんが、この方法ならできそうです。
どうも有難うございました。

回答No.2

noname#140971

Public Function FileWrite(ByVal FileName As String, _
　　　　　　　　　　　　　ByVal Text As String) As Boolean
On Error GoTo Err_FileWrite
　　Dim fso As Object
　　Dim txs As Object

　　Set fso = CreateObject("Scripting.FIleSystemObject")
　　Set txs = fso.CreateTextFile(FileName, True)
　　txs.Write Text
　　FileWrite = True
Exit_FileWrite:
　　Exit Function
Err_FileWrite:
　　MsgBox Err.Description & "(FileWrite)", vbExclamation, " 関数エラーメッセージ"
　　Resume Exit_FileWrite
End Function

Public Function FileReadArray(ByVal FileName As String) As String()
On Error GoTo Err_FileReadArray
　　Dim fso As Object
　　Dim strTexts() As String

　　Set fso = CreateObject("Scripting.FIleSystemObject")
　　strTexts() = Split(fso.OpenTextFile(FileName).ReadAll, vbCrLf)
Exit_FileReadArray:
　　FileReadArray = strTexts()
　　Exit Function
Err_FileReadArray:
　　MsgBox Err.Description & "(FileReadArray)", vbExclamation, " 関数エラーメッセージ"
　　strTexts() = Split("")
　　Resume Exit_FileReadArray
End Function

==================
質問自体への回答
==================

処理全体の流れは、全く同じことです。
ですから、先の回答も質問者のやり方で書けます。
ただ、それぞれが多少長くなるだけです。

お礼

CharCountとCutStrでもコンパイルエラーが出ましたが、教えてgooの中から拾えましたので無事分割できました。
accessはマクロが中心でVBAを自分でどうこうすることはほとんど無く、知り合いに作ってもらっていました。
これを機会に本格的に勉強しようかと思います。
有難うございました。