|
AutoFilterで、複数列(4列目と6列目)を抽出コピーだと、
4列目をAutoFilterかけて転記してから、いったん.AutoFilter解除して、
改めて 6列目にフィルタかけ、最初に転記したデータのあとに追加する
ということになり、手間が増えるので、
同じフィルタでもフィルタオプションによる抽出コピーのほうが
簡単で速そうです。
Private Sub CommandButton110_Click()
Dim ss As String
Dim fRange As Range
Dim cRange As Range
Dim CopyTo As Range
Dim s1 As String, s2 As String
ss = TextBox76.Text
ss = "*" & ss & "*"
With Worksheets("DATA")
Set fRange = .Range("A1").CurrentRegion 'フィルタ範囲
Set cRange = .Range("AA1") '抽出条件範囲先頭セル
s1 = .Range("D1").Value 'D列見出し
s2 = .Range("F1").Value 'F列見出し
End With
If WorksheetFunction.CountIf(fRange.Columns("D:F"), ss) > 0 Then
Set CopyTo = Worksheets("WAREA")
CopyTo.Parent.UsedRange.ClearContents
'cRange に抽出条件をセット
cRange.CurrentRegion.ClearContents
cRange(1, 1).Value = s1
cRange(1, 2).Value = s2
cRange(2, 1).Value = "'=" & ss
cRange(3, 2).Value = "'=" & ss
'フィルタオプションによる抽出コピーの実行
fRange.AdvancedFilter xlFilterCopy, _
CriteriaRange:=cRange.CurrentRegion, _
CopyToRange:=CopyTo
End If
End Sub
|
|