| |
▼Hirofumi さん：
お返事おそくなりました。全くの初心者なもので大変ご迷惑をおかけしております。何卒よろしくお願いします。
>「数学と英語の平均点を無記入にしている。」とは、SHeet1のB2:C4の範囲の事ですか？
ご指摘いただいた通りです。
>何回か、お尋ねしているのですが回答が無いので？もう一度確認します
>フィールド数が増えるレコードで、「,」が在るコメントのフィールドが「"」で括られていますか？
>CSVの仕様に従っている、データなら括られている筈です
>まともなアプリケーションで出力された物なら従っていると思います
秀丸にて確認したのですが、コメントのフィールドは「"」で括られておりません。
>次に、高校新人教師さんが修正したコードの「Sub DataExtract」、「Sub CSVRead」に相当する
>プロシージャを3プログラム分、Upして下さい
>（「Function SplitCsv」、「Function GetReadFile」、「Function GetWriteFile」は同じ筈なのでUpは必要ありません）
最初に、コメントの箇所（orすべてのフィールドにおいて）で、探したい文字列がある行を抽出するプログラムですが、以下の通りです。
３つ分ですが、時間のフィールドに時間以外の余計な値が入っているため、申し訳ありませんが、最初にコメント内での文字列のみの抽出に関する質問を優先させていただきます。
質問整理
ある１つないしは複数のｃｓｖファイルにおいて、
クラス,氏名,受験日時,自由コメント,数学の平均点,英語の平均点 （実際のファイルにはこちらの行は記載されておりません。下の行が1行目です。）
A,鈴木さん,12:00:00,コメント◯◯◯◯,70.40,55.33
B,佐藤さん,3:00:00,コメント◯◯◯◯,60.43,80.31
C,伊藤さん,3:00:00,コメント◯◯◯◯,80.77,68.29
・
・
・
・
・
・
・
・
があり、コメント欄において特定の文字列「○○」が書かれた行をすべて、他のファイルに抽出する。（コメント欄のみだけでなく、すべてのフィールドでも構いません。）
（また、コメントのカンマによってフィールドがずれてしまう件ですが、エクセル上で整形をしたので、コメントの列をすべてひとつの列の中にそろえましたので、もしもお手数になってしまうようでしたら、
コメントのカンマによってフィールドがずれてしまう問題に対応していなくても構いません。）
よろしくお願いします。
Public Sub DataExtract()
Dim i As Long
Dim vntInFiles As Variant
Dim dfo As Integer
Dim vntOutput As Variant
Dim strPath As String
Dim vntMark As Variant
Dim strProm As String
'指定形式のファイル名を取得
strPath = ThisWorkbook.Path & "\"
If Not GetReadFile(vntInFiles, strPath, True, "抽出元Fileを複数選択して下さい") Then
strProm = "マクロがキャンセルされました"
GoTo Wayout
End If
'出力ファイル名を取得
If Not GetWriteFile(vntOutput, strPath, "抽出先Fileを指定して下さい") Then
strProm = "マクロがキャンセルされました"
GoTo Wayout
End If
'抽出する名前を取得
With Worksheets("Sheet1")
vntMark = .Range(.Cells(2, "E"), .Cells(Rows.Count, "E").End(xlUp).Offset(1)).Value
End With
'出力ファイルをOpen
dfo = FreeFile
Open vntOutput For Output As dfo
For i = 1 To UBound(vntInFiles)
'データの読み込み
CSVRead vntInFiles(i), dfo, vntMark
Next i
Close dfo
strProm = "処理が完了しました"
Wayout:
MsgBox strProm, vbInformation
End Sub
Private Sub CSVRead(ByVal strFileName As String, _
dfo As Integer, _
vntMark As Variant, _
Optional strDelim As String = ",")
Dim dfn As Integer
Dim vntField As Variant
Dim strBuff As String
Dim blnMulti As Boolean
Dim strRec As String
Dim i As Long
'ファイルをOpen
dfn = FreeFile
Open strFileName For Input As dfn
Do Until EOF(dfn)
'１行読み込み
Line Input #dfn, strBuff
'論理レコードに物理レコードを追加
strRec = strRec & strBuff
'論理レコードをフィールドに分割
'フィールド内で改行が無い場合
If Not blnMulti Then
If vntField(0) <> "" Then
'配列変数vntFieldは、vntField(0):氏名、vntField(1):クラス
'・・vntField(5):数学の平均点、vntField(6):英語の平均点と成ります
'レコード中に、例えば「鈴木」という名前がある行を抽出
For i = 1 To UBound(vntMark, 1) - 1
'名前若しくはコメントの中に指定した文字列在る場合
If InStr(1, strRec, vntMark(i, 1), vbBinaryCompare) > 0 Then
'Forを抜ける
Exit For
End If
Next i
'もし指定文字列が有った場合
If i <= UBound(vntMark, 1) - 1 Then
'合成レコードを出力
Print #dfo, strRec
End If
End If
strRec = ""
Else
'セル内改行として残す場合
strRec = strRec & vbCrLf
End If
Loop
Close #dfn
End Sub
エラーとして、
If vntField(0) <> "" Then の箇所にデバックが起こるか、プログラムは動いたが、何も書き出せれていないかです。
ご迷惑をおかけしております。
|
|
高校新人教師
- 10/12/18(土) 7:17 -
