| |
▼kanabun さん：
ご指導ありがとうございます。
早々試験しました。
Textbox50に文字を入れてあいまい検索します。(*ﾜｲﾙﾄﾞｶｰﾄﾞ付けて)
エラーが
コンパイルエラー
参照が不正または不完全です
Private Sub CommandButton42_Click()が黄色になり
.Rangeが青い色でした、何度も申し訳ありませんが、ご指導お願いいたします。
>▼フィルター さん：
>
>>と書きましたが、実行すると、
>>実行時エラー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
>
>'動作未確認なので 不具合出るかも？
>'抽出処理を間違えてたらごめんなさい。
|
|
フィルター
- 08/12/12(金) 15:12 -
