Excel VBA質問箱 IV

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

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


9325 / 13644 ツリー ←次へ | 前へ→

【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 お礼[未読]

【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


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

【27959】Re:フォルダ内エクセルファイルシート全...
回答  こたつねこ  - 05/8/25(木) 13:28 -

引用なし
パスワード
   ▼umi さん:
こんにちわ

>サンプル名(Sample-1)やLot No.(S-0001)で検索をかけるとちゃんと抽出されます。
>しかし日付(2005/8/1)や温度(5)などで検索すると抽出できず困っています。

とのことですが

>KWord = Application.InputBox("検索名を入力して下さい。")

だと、KWordには文字型で格納されており

>If Sht.Cells(y, x).Value = strName Then

で、日付等の場合に一致しないのが原因だと思います。

明示的に型を変換して比較すれば思った動作をするの
ではないかと思いますがいかかがでしょう?

【27966】Re:フォルダ内エクセルファイルシート全...
発言  Jaka  - 05/8/25(木) 16:31 -

引用なし
パスワード
   こんにちは。
日付の場合は、シリアル値で比較しないと一致しないと思います。
例えばこんな感じに
MsgBox Range("A1").Value2 = CDbl(CDate("2005/8/25"))

温度の場合は、・・・・。
数値と文字数字の違いなのかなぁ?
よく解りません。

それと↓のコードは、なんでシートを指定していないのでしょうか?
いつまでたってもアクティブシート対象ですよ。
For y = 2 To Range("A65535").End(xlUp).Row

【27969】Re:フォルダ内エクセルファイルシート全...
発言  小僧  - 05/8/25(木) 17:12 -

引用なし
パスワード
   ▼umi さん、みなさま:
こんにちは。

どこかで見た事ある変数宣言だと思ったら…。

>それと↓のコードは、なんでシートを指定していないのでしょうか?
>いつまでたってもアクティブシート対象ですよ。
>For y = 2 To Range("A65535").End(xlUp).Row

それは、元ネタを作った人がそうだったから…。

>For Each Sht In ActiveWorkbook.Sheets
>        For y = 2 To Range("C65535").End(xlUp).Row
        For y = 2 To Sht.Range("C65535").End(xlUp).Row

すみませんでした。

【28004】Re:フォルダ内エクセルファイルシート全...
発言  umi  - 05/8/26(金) 8:20 -

引用なし
パスワード
   こたつねこさんありがとうございます。
初心者なものでよくわからないのですが、
明示的に型を変換するとはどういったことなのでしょう?
難しいでしょうか・・・?

【28005】Re:フォルダ内エクセルファイルシート全...
お礼  umi  - 05/8/26(金) 8:25 -

引用なし
パスワード
   小僧さん、はじめまして。
私が今回使用させていただいているコードの元ネタは小僧さんの作成したものです^^
勝手に使用させていただいて、さらに修正までしていただきありがとうございました。

【28012】Re:フォルダ内エクセルファイルシート全...
回答  こたつねこ  - 05/8/26(金) 12:52 -

引用なし
パスワード
   ▼umi さん:
こんにちわ

JAKAさんのサンプルコードの中にあるCDate関数とかが
それです。

A、B列を文字型、C列を日付型、D、E、Fを数値型
とした場合、strNameがVariant型なのでこんな感じが変
更点が少なく楽かもしれません。
*動くと思いますが動作確認はしておりません^^;

For x = 1 To 6
  '===ここから追加===
  Select Case x
    Case 3:   If IsDate(strName) Then strName = CDate(strName)
    Case 4 to 6: If IsNumeric(strName) Then strName = Val(strName)
  End Select
  '===ここまで追加===
  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

【28024】Re:フォルダ内エクセルファイルシート全...
お礼  umi  - 05/8/26(金) 17:48 -

引用なし
パスワード
   こたつねこさん、親切に教えていただきありがとうございました。
こたつねこさんに教えていただいたコードを追加すると、
日付でも検索できるようになりました。

この後もう少しやりたいことがあるので、
勉強しながら頑張ってみたいと思います。

また困ったときには質問させていただきたいと思いますので
よろしくお願いします。

本当にありがとうございました。

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