Excel VBA質問箱 IV

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

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


14859 / 76738 ←次へ | 前へ→

【67367】Re:特定の範囲内の値をもつ行を抽出しコピーする方法(CSVファイル)
回答  Hirofumi  - 10/11/28(日) 11:26 -

引用なし
パスワード
   >続けて質問してしまって大変恐縮ですが、
>平均点の下限、上限を指定するだけでなく、
>投稿時間が12:00:00~15:00:00をの行を抽出したり、
>名前やコメントの中で、例えば「鈴木」という名前がある行を同様に抽出するためには、
>どのようにコードを変えていけばよいのでしょうか?

このコードは、私が使っている古臭いコードを少し編集した物なので処理速度を求める等なら
もっと改良が必要だと思います

先ず、
1、「Function GetReadFile」と「Function GetWriteFile」は
 「ファイルを開く」、「保存するファイル名」を出すプロシージャで
 特に今回の場合変更はしなくても善いかと思います

2、「Function SplitCsv」はCSV用の分割関数で
 戻り値は、Vriant型の配列で、添え字の基底が0の1次元配列と成ります
 Delimiterが無い場合は、基底だけの配列にstrLineで与えた文字列が帰ります
 また、フィールドが「"」で括られている場合其の処理を行います
 (「"」で括られているフィールドの中に在る「,」はデータと見なし分割されません)
 引数 strLine は分割元の文字列を与えます
 引数 strDelimiter、引数 strQuote、引数 strRetは通常は指定しません
 引数 blnMultiは分割する文字列の中に在る、「"」を「,」を比較し辻褄が合わない場合
    Trueを返します(例えば「"」で括られているフィールドの中に改行コーど等が在る場合)

抽出条件を代えたプログラムを幾つか作るのでしょうから、
上記3点のプロシージャを別な標準モジュールを設けて其処に移動します
そして、3点ともPrivate宣言されていますので、其れをPublicの宣言に変更します
そうすれば、どのモジュールからも呼び出せますので、一々上記のプロシージャを
増殖させる必要は在りません

変更の殆どは「Sub DataExtract」、「SuB CSVRead」で行う事に成りますので
要点だけを書きます
上記と別な標準モジュールに「Sub DataExtract」と「 Sub CSVRead」をCopyして
「Sub DataExtract」の名前を変更します

a) 例、受験時間が12:00:00~15:00:00をの行を抽出

Sheet1のB5に下限、C5に上限時間を書くとします
「Sub DataExtract」の変更部分

  '抽出する下限、上限値を取得
  vntMark = Worksheets("Sheet1").Cells(2, "B").Resize(2, 2).Value



  '抽出する下限、上限値を取得
  vntMark = Worksheets("Sheet1").Cells(5, "B").Resize(, 2).Value

とします

「 Sub CSVRead」の変更

  Dim strRec As String
'  Dim lngMax As Long ' ★削除
 ・
 ・

    'フィールド内で改行が無い場合
    If Not blnMulti Then
      If vntField(0) <> "" Then
        '配列変数vntFieldは、vntField(0):氏名、vntField(1):クラス
        '・・vntField(5):数学の平均点、vntField(6):英語の平均点と成ります
        '但し、コメントフィールドの「,」が在る場合、「"」で括られているなら
        '受験時間が12:00:00~15:00:00をの行を抽出
        If vntMark(1, 1) <= TimeValue(vntField(3)) _
            And TimeValue(vntField(3)) <= vntMark(1, 2) Then
            '合成レコードを出力
            Print #dfo, strRec
          End If
        End If
      End If
      strRec = ""
    Else

とします

b) 例、名前やコメントの中で、例えば「鈴木」という名前がある行を抽出

Sheet1のE2から下にE3、E4・・と名前を書くとします
「Sub DataExtract」の変更部分

  '抽出する下限、上限値を取得
  vntMark = Worksheets("Sheet1").Cells(2, "B").Resize(2, 2).Value



  '抽出する名前を取得
  With Worksheets("Sheet1")
    vntMark = .Range(.Cells(2, "E"), .Cells(Rows.Count, "E").End(xlUp).Offset(1)).Value
  End With

とします

「 Sub CSVRead」の変更

  Dim strRec As String
'  Dim lngMax As Long ' ★削除
  Dim i As Long ' ★追加

 ・
 ・
  
    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, vntField(0), vntMark(i, 1), vbBinaryCompare) > 0 _
              Or InStr(1, vntField(4), 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

とします

以上

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 お礼

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