| |
▼フィルター さん：
>と書きましたが、実行すると、
>実行時エラー13 型が一致しませんと表示され
>If WorksheetFunction.CountIf(fRange.Columns("F:L:R:X:AD:AJ"), ss) > 0 Thenの部分が黄色くなります。
その行の意味は "F,L,R,X,AD,AJ" 列に TextBox50の文字列が1つ以上あったら
以下を実行する、というIf文ですね？
で、複数列範囲の指定の仕方が構文エラーになっているわけですね？
AdvancedFilterで抽出の処理は、仮に１つも条件に合う行がなく
抽出されなくてもエラーになるわけではありません。
なので、、その部分を書かないでAdvancedFilter実行して、結果が
1行以上抽出されていたら、その後の処理をつづける、としたら
どうなりますか？
（確認ですが、"F,L,R,X,AD,AJ" 列から 検索する文字列は
どの列も TextBox50.Text なんですよね？ ）
Private Sub CommandButton42_Click()
Dim ss As String
Dim fRange As Range 'フィルタ範囲（検索範囲 見出し行含む）
Dim cRange As Range '抽出条件範囲（の先頭セル）
Dim CopyTo As Range ' 抽出先（別シート）先頭セル
ss = TextBox50.Text 'この文字列を検索する
ss = "'=*" & ss & "*"
With Worksheets("DATA")
Set fRange = .Range("A1").CurrentRegion 'フィルタ範囲
Set cRange = .Range("AO1") '抽出条件範囲先頭セル
End With
Set CopyTo = Worksheets("WAREA").Range("A1") 'ここへ抽出する
CopyTo.Parent.UsedRange.ClearContents
'cRange に抽出条件をセット
cRange.CurrentRegion.ClearContents
cRange(1, 1).Value = .Range("F1").Value 'F列見出し
cRange(1, 2).Value = .Range("L1").Value 'L列見出し
cRange(1, 3).Value = .Range("R1").Value 'R列見出し
cRange(1, 4).Value = .Range("X1").Value 'X列見出し
cRange(1, 5).Value = .Range("AD1").Value 'AD列見出し
cRange(1, 6).Value = .Range("AJ1").Value 'AJ列見出し
cRange.Range("A2,B3,C4,D5,E6,F7").Value = ss
'フィルタオプションによる別シートへ抽出の実行
fRange.AdvancedFilter xlFilterCopy, _
CriteriaRange:=cRange.CurrentRegion, _
CopyToRange:=CopyTo
'データが１行も抽出されていなければ、Exitする
Dim ListRange As Range
With CopyTo.CurrentRegion '抽出データ範囲から
On Error Resume Next '↓ 見出しを除く
Set ListRange = Intersect(.Cells, .Offset(1))
On Error GoTo 0
If ListRange Is Nothing Then Exit Sub
End With
'抽出データをリストボックスにセット
With ListBox1
.ColumnHeads = True
.ColumnCount = ListRange.Columns.Count
.ColumnWidths = "30;80;55;60;60;60;65;45;45;45;25"
.RowSource = ListRange.Address(External:=True)
End With
End Sub
'動作未確認なので 不具合出るかも？
'抽出処理を間違えてたらごめんなさい。
|
|
kanabun
- 08/12/12(金) 11:49 -
