エクセルＶＢＡでＦＩＮＤで年月のみを取得したいのですが。

質問

環境はＷＩＮ９８、エクセル２０００です。

注文表を日付、顧客コード、品目コード、価格の順で入力しています。
Ａ列に2001/2/18のように日付を入れています。日付は古い方から順にならんでいます。また、同じ日付の行もたくさんあります。

例えば、２００１年２月の注文だけをシート２に書き出すために、現在はdo loopを使用し、日付から年月のみを取り出し、該当年月の最初の行と、月が変わった行を探し、この範囲を範囲指定してコピーでシート２に写しています。

ＦＩＮＤを使えばもっと簡単に指定月の最初の行と、最後の行を簡単に見つけられるのでは、と思い、いろいろ試してみましたが、いい方法が見つかりません。
ＦＩＮＤＮＥＸＴでは、最初に2001/2/1とすると次の日付(2001/2/2)が検索され、2001/3月が検索できません。

簡単に探したい月の最初に日付行と最後の日付行を検索する方法はありませんでしょうか。

ご存じの方、よろしくお願いします。

回答No.2

nishi6 · ベストアンサー

問題を、昇順に並んだ日付から指定した年月のデータを抽出して別シートに書き出す。と理解しましたので下記のコードを書いてみました。
＜条件＞質問から、「日付、顧客コード、品目コード、価格」がＡ１からＤ１に入力されていて、データは２行目から連続に入力。またセル「Ｆ２」に抽出する年月日を「yyyy/m/d」で入力（日は月末までの任意）としています。
＜要点＞２月を検索する時に、翌月の３月１日を検索することにすると、まだ２月の時はデータがありませんし、休日とかで注文が無い場合も想定されると思い、指定した２月を１ヶ月間調べるようにしています。
Findを行った後、見つかったらFindNextを行って重複データを探しています。Sheet2は書き出すときにクリアしています。
コードを書きながら思ったことですが、このような処理はデータベースソフト（Accessとか）を使ったほうが便利かな・・・と。データがどんどん増えていく場合はExcelは不向きかもしれませんし・・・？
質問の意を汲んでいればと思います。がんばってください。
下記コードを標準モジュールを追加して、貼り付けてください。シート1からマクロKensakuを実行します。コードを登録すると先頭空白が消えるので、段下げをしてもらえば見やすくなると思います。

Option Explicit

Public Sub Kensaku()
Dim wk1, wk2 As Worksheet 'ワークシート
Dim schRg As String '検索範囲
Dim iYY, iMM As Integer '検索値(年、月)
Dim sDate As Date '検索値(年月日)
Dim tDate As String '検索値(テキスト)
Dim c '検索結果セル
Dim fstFind As String '最初に検索したセル
Dim Xpot1, Xpot2 As String 'セル座標(左上と右下)
Dim d As Integer '日付カウンタ
'設定
Set wk1 = Worksheets("Sheet1")
Set wk2 = Worksheets("Sheet2")
wk1.Activate: Range("A1").Select
iYY = Year(wk1.Range("F2")) 'セルF2に年月日を入力！！
iMM = Month(wk1.Range("F2"))
'検索範囲
schRg = "A1:A" & ActiveSheet.UsedRange.Rows.Count
'==============================
'F2に入力した年月を１ヶ月間検索
'==============================
With wk1.Range(schRg)
For d = 1 To Day(DateSerial(iYY, iMM + 1, 1) - 1)
sDate = DateSerial(iYY, iMM, d)
tDate = Application.Text(sDate, wk1.Range("A2").NumberFormat)
'検索実施
Set c = .Find(tDate)
'見つかった！
If Not c Is Nothing Then
fstFind = c.Address: Xpot2 = c.Offset(0, 3).Address
'最初の検索アドレス
If Xpot1 = "" Then Xpot1 = fstFind
'重複日を調べる
Do
Set c = .FindNext(c)
If c.Address <> fstFind Then
Xpot2 = c.Offset(0, 3).Address
End If
Loop While Not c Is Nothing And c.Address <> fstFind
End If
Next
End With
'=====================
'検索結果をシート2にコピー
'=====================
If Xpot1 <> "" Then
'シート2をクリア
wk2.Select: Cells.Select: Selection.ClearContents
'コピー
wk2.Range("A1") = wk1.Range("A1") '表題
wk2.Range("B1") = wk1.Range("B1")
wk2.Range("C1") = wk1.Range("C1")
wk2.Range("D1") = wk1.Range("D1")
wk1.Select: Range(Xpot1 & ":" & Xpot2).Select
Selection.Copy
'貼り付け
wk2.Select: Range("A2").Select: ActiveSheet.Paste
Range("A1").Select
'復帰
wk1.Select: Range("F2").Select
Else
MsgBox "該当データがありません"
End If
End Sub

お礼

ありがとうございました。
ＦＩＮＤＮＥＸＴをこのように使うと良いんですね。
早速組み込んでみます。

質問では、簡単に書きましたが、商品コード、区域など入力項目は２０項目程度あります。

このデータはオンライン入力データを加工して、サーバーに保存され、必要な部署が自由に利用できるようになっています。
おっしゃるようにアクセスを利用する方が良いとは思いますが、当社の規定表計算ソフトはエクセルで、エクセルは全端末にインストールされており、どこでも利用出ます。

それと、アクセスは利用する部署で別途購入が必要になりますのと、使える人がいません。エクセルは集合研修も行い、ほとんどの人が使えます。
データ件数も月間４万件程度ですので、何とかエクセルで間に合わせてます。
ご助言ありがとうございました。

回答No.1

kbonb

こんにちは

　以下のページがご参考になるのでは？

[XL2000]Find メソッドで日付と時刻形式のデータを検索できない
http://www.microsoft.com/JAPAN/support/kb/articles/J055/6/07.htm

参考URL：

http://www.microsoft.com/JAPAN/support/kb/articles/J055/6/07.htm

補足

ありがとうございました。
でも、ちょっと違うんです。
日付(2001/2/1のようにきろくされています)はＦＩＮＤで検索できますが、この日付の内2001/2の最初の行及び2001/2/28の最後の行又は2001/3/1の最初の行を検索し、当該行の値を知りたいのです。
注文を受けたものを順に記録しますので、同じ日付はたくさんあります。
よろしくお願いします。