エクセル/マクロ コンボボックスからの検索とセル位置の取得

質問

エクセル/マクロに関する質問です。あるワークシートのA列に日付、B列にその日付に対応した商品の名前が入っています。データは日付順に並んでいます。A列の中には重複する日付もあります。ユーザーフォームを使用して、ある一定の期間内のデータを新しいシートにペーストしたいと考えています。

ユーザーフォームには2つのコンボボックス、1つのテキストボックスを設置しました。コンボボックスAでは、コピーしたいデータが始まる日付が選択できるようになっており、コンボボックスBではコピーしたいデータの最後の日付が選択できるようになっています。
Private Sub UserForm_Initialize()
Dim DateList1 As New Collection
Dim Row1 As String, TopCell1 As String, BottomCell1 As String
Dim CellRange1 As Range, EachCell1 As Range

Row1 = "A"
TopCell1 = Row1 & "3"
BottomCell1 = Row1 & "65536"
With Worksheets("AAA")
Set CellRange1 = .Range(.Range(TopCell1), .Range(BottomCell1).End(xlUp))
End With
For Each EachCell1 In CellRange1
On Error Resume Next
DateList1.Add EachCell1.Value, CStr(EachCell1.Value)
If Err.Number = 0 Then
Me.ComboBoxA.AddItem EachCell1.Value
End If
On Error GoTo 0
Next
End Sub

テキストボックスでは新しいシートの名前を入力できるようにしています。

コンボボックスA、Bで選んだ項目に一致するセルの行番号を取得しその範囲をコピー、新しいシートにペーストしたいと考えています。さらにコンボボックスAの日付がBをこえないようにしたいとも考えています。

できるだけシンプルなコードで表現したいのですが、なかなか上手くいきません。スマートなアイデアをお持ちの方がいらっしゃれば、アドバイスを頂きたいと思います。どうぞよろしくお願いします。

回答No.2

imogasi · ベストアンサー

エクセルの機能をできるだけ使ってやってみた。
ユーザーフォームに
テキストボックスを２つ（「から」の日と「まで」の日）。
コマンドボタンを１つ設ける。
コマンドボタンのクリックイベントに
ーー
Private Sub CommandButton1_Click()
Set sh1 = Worksheets("Sheet1")
Set sh2 = Worksheets("Sheet2")
f = DateValue(TextBox1.Text)
t = DateValue(TextBox2.Text)
sh1.Range("F1") = sh1.Cells(1, "A")
sh1.Range("F2") = ">=" & Format(f, "yyyy/mm/dd")
sh1.Range("G1") = sh1.Cells(1, "A")
sh1.Range("G2") = "<=" & Format(t, "yyyy/mm/dd")
d = sh1.Range("A65536").End(xlUp).Row
sh1.Range("A1:B" & d).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=sh1.Range( _
"F1:G2"), CopyToRange:=sh2.Range("A1:b100"), Unique:=False
sh1.Range("F1:G2").ClearContents
Me.Hide
Set sh1 = Nothing
Set sh2 = Nothing
End Sub
ーー
ユーザーフォームを表示し
からとまでの日付を入力。コマンドボタンをクリック。
例データ
Ｓｈｅｅｔ１
日付 名前
2009/11/2 a
2009/11/23 b
2009/11/30 c
2009/12/3 d
2009/12/4 e
2009/12/6 f
2009/12/15 g
2009/12/15 h
2009/12/18 i
2009/12/19 j
2009/12/20 k
2009/12/21 l
ーーー
日付は
2009/12/3
2009/12/15
---
結果
Ｓｈｅｅｔ２
日付 名前
2009/12/3 　　d
2009/12/4　 e
2009/12/6 　　f
2009/12/15 g
2009/12/15 h

補足

テキストボックスの代わりにコンボボックスを使ってユーザーフォームを作りました。希望通りのフォームになりました。ありがとうございました。

回答No.1

mitarashi

collectionを使って、重複はエラー処理で逃げるというのは、確かにスマートではないかもしれませんね。
dictionary（連想配列）を使われてはいかがですか。日付の最大値と、最小値を取得して済ませる手もあると思います。
他にフィルタオプション案もあります。別のQ&Aで、フィルタオプションで別シートに書き出すのを覚えたばかりなので、ご参考までに。セル範囲をを一次元の配列に一括変換して、コンボボックスのListに一括で設定しようとしましたが、表示形式が日付シリアルになってしまってうまく行きません。（文字列に変換すると、結局一括でできませんし）
Private Sub UserForm_Initialize()
Dim targetRange As Range, destRange As Range
Dim i As Long
'後で消しますが、差し障りのない場所を指定してください。
Set destRange = Sheets("Sheet2").Range("A1")
With Sheets("Sheet1")
Set targetRange = .Range(.Range("A3"), .Range("A" & .Rows.Count).End(xlUp))
End With
targetRange.AdvancedFilter Action:=xlFilterCopy, CopyToRange:=destRange, Unique:=True
Set destRange = destRange.CurrentRegion
For i = 2 To destRange.Rows.Count
Me.ComboBox1.AddItem CDate(destRange.Cells(i))
Next i
destRange.Cells.Clear
End Sub
指定期間内のデータを他シートに貼り付けるのは、下記に盛りだくさんの案がありご参考になると思います。
http://okwave.jp/qa5498229.html

お礼

フィルタオプションを使う事にしました。
いろいろ参考になりました。ありがとうございました。