Excel VBA質問箱 IV

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

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


14615 / 76738 ←次へ | 前へ→

【67612】Re:特定の範囲内の値をもつ行を抽出しコピーする方法(CSVファイル)
質問  高校新人教師  - 10/12/18(土) 7:17 -

引用なし
パスワード
   ▼Hirofumi さん:
お返事おそくなりました。全くの初心者なもので大変ご迷惑をおかけしております。何卒よろしくお願いします。

>「数学と英語の平均点を無記入にしている。」とは、SHeet1のB2:C4の範囲の事ですか?

ご指摘いただいた通りです。

>何回か、お尋ねしているのですが回答が無いので?もう一度確認します
>フィールド数が増えるレコードで、「,」が在るコメントのフィールドが「"」で括られていますか?
>CSVの仕様に従っている、データなら括られている筈です
>まともなアプリケーションで出力された物なら従っていると思います

秀丸にて確認したのですが、コメントのフィールドは「"」で括られておりません。


>次に、高校新人教師さんが修正したコードの「Sub DataExtract」、「Sub CSVRead」に相当する
>プロシージャを3プログラム分、Upして下さい
>(「Function SplitCsv」、「Function GetReadFile」、「Function GetWriteFile」は同じ筈なのでUpは必要ありません)

最初に、コメントの箇所(orすべてのフィールドにおいて)で、探したい文字列がある行を抽出するプログラムですが、以下の通りです。
3つ分ですが、時間のフィールドに時間以外の余計な値が入っているため、申し訳ありませんが、最初にコメント内での文字列のみの抽出に関する質問を優先させていただきます。

質問整理

ある1つないしは複数のcsvファイルにおいて、

クラス,氏名,受験日時,自由コメント,数学の平均点,英語の平均点  (実際のファイルにはこちらの行は記載されておりません。下の行が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)
    '1行読み込み
    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 の箇所にデバックが起こるか、プログラムは動いたが、何も書き出せれていないかです。

ご迷惑をおかけしております。

0 hits

【67353】特定の範囲内の値をもつ行を抽出しコピーする方法(CSVファイル) 高校新人教師 10/11/27(土) 5:12 質問
【67354】Re:特定の範囲内の値をもつ行を抽出しコピ... Hirofumi 10/11/27(土) 8:52 発言
【67355】Re:特定の範囲内の値をもつ行を抽出しコピ... Hirofumi 10/11/27(土) 9:25 発言
【67356】Re:特定の範囲内の値をもつ行を抽出しコピ... Hirofumi 10/11/27(土) 10:31 回答
【67365】Re:特定の範囲内の値をもつ行を抽出しコピ... 高校新人教師 10/11/28(日) 6:51 お礼
【67367】Re:特定の範囲内の値をもつ行を抽出しコピ... Hirofumi 10/11/28(日) 11:26 回答
【67368】Re:特定の範囲内の値をもつ行を抽出しコピ... Hirofumi 10/11/28(日) 11:29 回答
【67414】Re:特定の範囲内の値をもつ行を抽出しコピ... 高校新人教師 10/12/1(水) 23:52 お礼
【67415】Re:特定の範囲内の値をもつ行を抽出しコピ... Hirofumi 10/12/2(木) 8:57 回答
【67533】Re:特定の範囲内の値をもつ行を抽出しコピ... 高校新人教師 10/12/11(土) 2:24 お礼
【67536】Re:特定の範囲内の値をもつ行を抽出しコピ... Hirofumi 10/12/11(土) 9:51 回答
【67612】Re:特定の範囲内の値をもつ行を抽出しコピ... 高校新人教師 10/12/18(土) 7:17 質問
【67615】Re:特定の範囲内の値をもつ行を抽出しコピ... Hirofumi 10/12/18(土) 9:59 回答
【67731】Re:特定の範囲内の値をもつ行を抽出しコピ... 高校新人教師 11/1/5(水) 19:36 お礼
【67846】Re:特定の範囲内の値をもつ行を抽出しコピ... 高校新人教師 11/1/13(木) 4:58 質問
【67847】Re:特定の範囲内の値をもつ行を抽出しコピ... Hirofumi 11/1/13(木) 9:40 回答
【67730】Re:特定の範囲内の値をもつ行を抽出しコピ... 高校新人教師 11/1/5(水) 19:34 回答
【67764】Re:特定の範囲内の値をもつ行を抽出しコピ... 高校新人教師 11/1/7(金) 3:35 お礼
【67766】Re:特定の範囲内の値をもつ行を抽出しコピ... Hirofumi 11/1/7(金) 8:00 回答
【67845】Re:特定の範囲内の値をもつ行を抽出しコピ... 高校新人教師 11/1/13(木) 4:45 お礼

14615 / 76738 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free