Excel VBA質問箱 IV

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

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


53588 / 76732 ←次へ | 前へ→

【27956】フォルダ内エクセルファイルシート全文検索について。
質問  umi  - 05/8/25(木) 11:26 -

引用なし
パスワード
   はじめまして。
初心者で恐縮ですが質問させてください。

過去ログを参考にして色々と調べながら試しているのですが、
表示形式が日付になっている値や、数字のみの値が抽出できなくて困っています。

シート例

  A     B     C     D     E     F
 サンプル名  Lot No.  製造日   温度1.  温度2.   温度3.
 Sample-1  S-0001  2005/8/1   5    15     25
 Sample-2  S-0002  2005/8/2   5    15     25
 Sample-3  S-0003  2005/8/3   5    15     25
  ・     ・    ・     ・    ・     ・
  ・     ・    ・     ・    ・     ・
  ・     ・    ・     ・    ・     ・
  ・     ・    ・     ・    ・     ・


上記のようなエクセルファイルがフォルダ内にたくさんあります。
このファイルの中から、指定した日付に該当するサンプルの行を検索・抽出
したいのですが、うまくいきません。
サンプル名(Sample-1)やLot No.(S-0001)で検索をかけるとちゃんと抽出されます。
しかし日付(2005/8/1)や温度(5)などで検索すると抽出できず困っています。
作成したコードは以下のようになっています。


Sub フォルダ内検索()
Dim FSO As Object
Dim FolPath As String
Dim Fol As Object
Dim Fil As Object
Dim KWord As Variant

  FolPath = "C:\Documents and Settings\b-okanishi\デスクトップ\test2\"
  KWord = Application.InputBox("検索名を入力して下さい。")
    If KWord = "" Or KWord = False Then Exit Sub
'--------------------------------------------------------------
  Application.DisplayAlerts = False
  Application.ScreenUpdating = False
'--------------------------------------------------------------
  ActiveSheet.Range(Rows(2), Rows(2).End(xlDown)).ClearContents

  Set FSO = CreateObject("Scripting.FileSystemObject")
  Set Fol = FSO.GetFolder(FolPath)
    For Each Fil In Fol.Files
      If FSO.GetExtensionName(Fil.Name) = "xls" Then
        Call データ検索(KWord, FolPath & Fil.Name)
      End If
    Next
  Set Fil = Nothing
  Set Fol = Nothing
  Set FSO = Nothing
'--------------------------------------------------------------
  Application.DisplayAlerts = True
  Application.ScreenUpdating = True
'--------------------------------------------------------------
End Sub

Function データ検索(strName As Variant, FName As String)
Dim motoSheet As Worksheet
Dim Sht As Worksheet
Dim y As Long
Dim x As Long
  Set motoSheet = ActiveSheet
    Workbooks.Open (FName)
      For Each Sht In ActiveWorkbook.Sheets
        For y = 2 To Range("A65535").End(xlUp).Row
          For x = 1 To 6
            If Sht.Cells(y, x).Value = strName Then
              Sht.Rows(y).Copy
              motoSheet.Paste motoSheet.Rows _
                (motoSheet.Range("A65535").End(xlUp).Row + 1)
              Exit For
            End If
          Next
        Next
      Next
    ActiveWorkbook.Close (False)
  Set motoSheet = Nothing
End Function


初心者で恐縮ですが、解決方法を教えていただけると助かります。
よろしくお願いします。
1 hits

【27956】フォルダ内エクセルファイルシート全文検索について。 umi 05/8/25(木) 11:26 質問
【27959】Re:フォルダ内エクセルファイルシート全文... こたつねこ 05/8/25(木) 13:28 回答
【28004】Re:フォルダ内エクセルファイルシート全文... umi 05/8/26(金) 8:20 発言
【28012】Re:フォルダ内エクセルファイルシート全文... こたつねこ 05/8/26(金) 12:52 回答
【28024】Re:フォルダ内エクセルファイルシート全文... umi 05/8/26(金) 17:48 お礼
【27966】Re:フォルダ内エクセルファイルシート全文... Jaka 05/8/25(木) 16:31 発言
【27969】Re:フォルダ内エクセルファイルシート全... 小僧 05/8/25(木) 17:12 発言
【28005】Re:フォルダ内エクセルファイルシート全... umi 05/8/26(金) 8:25 お礼

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