| |
>▼kanabun さん：
>ご指導、ありがとうございます。
URL見て直しましたがうまく動作しませんでした。
何度も質問、ご指導すいませんです。
最終的な条件は
列はF・L・R・X・AD・AJの６列で
２行目から５００行まで検索対象データが入っています。
検索後リストボックスに表示するようにしています。
”構文”は・・
Private Sub CommandButton42_Click()
Dim ss As String
Dim fRange As Range
Dim cRange As Range
Dim CopyTo As Range
Dim s1 As String, s2 As String, s3 As String, s4 As String, s5 As String, s6 As String
ss = TextBox50.Text
ss = "*" & ss & "*"
With Worksheets("DATA")
Set fRange = .Range("A1").CurrentRegion 'フィルタ範囲
Set cRange = .Range("AO1") '抽出条件範囲先頭セル
s1 = .Range("F1").Value 'F列見出し
s2 = .Range("L1").Value 'L列見出し
s3 = .Range("R1").Value 'R列見出し
s4 = .Range("X1").Value 'X列見出し
s5 = .Range("AD1").Value 'AD列見出し
s6 = .Range("AJ1").Value 'AJ列見出し
End With
If WorksheetFunction.CountIf(fRange.Columns("F:L:R:X:AD:AJ"), 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(1, 3).Value = s3
cRange(1, 4).Value = s4
cRange(1, 5).Value = s5
cRange(1, 6).Value = s6
cRange(2, 1).Value = "'=" & ss
cRange(3, 2).Value = "'=" & ss
cRange(4, 3).Value = "'=" & ss
cRange(5, 4).Value = "'=" & ss
cRange(6, 5).Value = "'=" & ss
cRange(7, 6).Value = "'=" & ss
'フィルタオプションによる抽出コピーの実行
fRange.AdvancedFilter xlFilterCopy, _
CriteriaRange:=cRange.CurrentRegion, _
CopyToRange:=CopyTo
End If
With Worksheets("WAREA")
IRow = .Range("A" & Rows.Count).End(xlUp).Row + 1
End With
With ListBox1
.ColumnHeads = True
.ColumnCount = 11
.ColumnWidths = "30;80;55;60;60;60;65;45;45;45;25;"
'.Text = "DATA!A2:K500"
.RowSource = "WAREA!A2:K2500"
End With
End Sub
と書きましたが、実行すると、
実行時エラー13 型が一致しませんと表示され
If WorksheetFunction.CountIf(fRange.Columns("F:L:R:X:AD:AJ"), ss) > 0 Thenの部分が黄色くなります。
どの用に対処、修正すればいいでしょうか？重ね重ねすいません。
よろしくご指導お願いいたします。
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
- 08/12/12(金) 22:40 -
