| |
neptuneさん、ゆとさん、PiPiさん、こんにちは。
皆さんのご意見を参考にさせて頂き、以下のコードを作ってみました。
なんとか目的の結果に達することが出来ました。
皆さんありがとうございました。
Sub Test1()
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Set sh1 = Worksheets("List") 'リスト
Set sh2 = Worksheets("List2") '条件登録、結果表示
Dim KeyA1 As String '条件1(min)
Dim KeyA2 As String '条件1(max)
Dim keyB1 As String '条件2(min)
Dim KeyB2 As String '条件2(max)
KeyA1 = ">=" & sh2.Cells(2, 2)
KeyA2 = "<=" & sh2.Cells(2, 3)
keyB1 = ">=" & sh2.Cells(3, 2)
KeyB2 = "<=" & sh2.Cells(3, 3)
'先回の結果をクリア (結果表示先List2ｼｰﾄA5:D20)
sh2.Activate
Range(Cells(5, 1), Cells(20, 4)).Select
Selection.ClearContents
'オートフィルターで条件1、条件2を抽出
sh1.Activate
sh1.Cells(1, 1).Select
Selection.AutoFilter
'条件1
Selection.AutoFilter Field:=1, Criteria1:=KeyA1, Operator:=xlAnd, _
Criteria2:=KeyA2
'条件2
Selection.AutoFilter Field:=2, Criteria1:=keyB1, Operator:=xlAnd, _
Criteria2:=KeyB2
'抽出結果をコピーして結果表示場所に貼付け
Do While ActiveCell.Value <> ""
ActiveCell.Offset(1).Select
Loop
i = ActiveCell.Row
Range(Cells(1, 1), Cells(i, 4)).Select
Selection.Copy
sh2.Activate
sh2.Cells(5, 1).Select
ActiveSheet.Paste
End Sub
|
|
yasu145
- 06/10/27(金) 14:58 -
