|
Private Sub ExFind()
Dim s As String
Dim coun As Long
Dim last As Long
'抽出条件の作成
If Range("B4") <> "" Then
Range("B12") = "*" & Range("B4") & "*"
End If
If Range("C4") <> "" Then
Range("C12") = "*" & Range("C4") & "*"
End If
'検索結果コピー領域のクリア
Range("A20").CurrentRegion.ClearContents
Sheets("Sheet2").Select
ActiveSheet.Range("A1").Activate
last = ActiveSheet.Range("A1").End(xlDown).Row
'抽出しコピー
ActiveSheet.Range("A1:C" & last).AdvancedFilter Action:=xlFilterCopy, Criteriarange:=Range("B11:C12"), copytorange:=Range("A20"), unique:=False
'結果表示
Sheets("Sheet1").Select
If Range("A21") = "" Then
Range("B15") = "見つかりませんでした。"
Else
coun = Range("A20").End(xlDown).Row - 20
Range("B15") = coun & " 件見つかりました。"
End If
'抽出条件のクリア
Range("B12:C12") = ""
End Sub
Private Sub CommandButton1_Click()
ExFind
End Sub
|
|