| |
はじめまして。めがめがといいます。
よろしくお願いします。
漫画シートと抽出シートがあり、
抽出シート
E列 F列 J1=３
1行目 タイトル タイトル
2行目 *あ* あ
3行目 *い* い
4行目 *う* う
J1は、抽出シートに直接関数を入れて、タイトルを除くタイトルの個数を
CONTA関数で取得し表示しています。
F列にタイトルの一部を入力し、VBAで、抽出する際に、
E列に*を前後につけた物を転機し、それらを配列に格納し、
その配列を使用して、
漫画シートを、あいまい検索をかけています。
配列を使用しているのは、この検索をした後にまた別のマクロを
実行する場合があり、Criteria1をどうしても使用したいからです。
CriteriaRangeで、Ｅ列の抽出タイトルの部分を選択して、抽出すると、
オートフィルターの矢印がつかないので、
その後、さらに、他のマクロで、再度別条件で絞り込んいく事ができません。
その為、Criteria1の方を使用しています。ただ、この配列による抽出は、
完全一致などだとうまくいくんですが、
上記のような、あいまい検索の場合、2件までしか正常に作動しません。
*あ*
*い*
まででしたら、それらを配列に格納して、抽出できますが、
*あ*
*い*
*う*
になると、結果は０件で、漫画シートには何も表示されません。
どうしたら、Criteria1の配列を使用した検索で、３件以上のあいまい検索ができますか？または、CriteriaRangeを使用して絞り込んだデータを一旦、目視して、必要な時、別のマクロで別条件でさらに絞り込む事は可能ですか？可能でしたら、
わざわざ、Criteria1の配列による検索などしないのですが。
コードはこういうのを書いています。
Sub 漫画タイトル抽出2()
'一旦 フィルター解除
If Worksheets("漫画").FilterMode = True Then
Worksheets("漫画").ShowAllData
End If
Sheets("抽出").Select
'抽出シート 以前のタイトル 事前に一旦クリア
With Cells(50000, 5)
'最終行の１つ下の行を取得。これを、最終行のみ取得すると、タイトル列に何も入力されてない場合に、見出しのE1まで消えてしまう。その為.Offset(1,0)が必要
Worksheets("抽出").Range("E2:E" & .Cells(.Cells.Rows.Count, 1).End(xlUp).Row).Offset(1, 0).ClearContents 'ClearContents 値のみクリア
End With
'あいまい検索の為に、作業列に*つけてタイトル結合
Dim endRow_F As Long
endRow_F = Cells(Rows.Count, "F").End(xlUp).Row
For i = 2 To endRow_F
Cells(i, "E").Value = "*" + Cells(i, "F").Value + "*"
Next i
'検索 抽出
Dim cnt_code As Integer
Sheets("抽出").Select
'エクセルのＪ１に設定してあるコードのカウント数を取得
cnt_code = Range("J1").Value - 1
Dim code() As String
Dim fRng As Range
'動的配列の個数をここで設定
If cnt_code >= 0 Then
ReDim code(cnt_code)
End If
For i = 0 To cnt_code '抽出isbn
code(i) = Range("E2").Offset(i, 0).Value '*タイトル 配列に格納
MsgBox "code" & i & "=" & code(i)
Next i
Sheets("漫画").Select
If cnt_code >= 0 Then
Range("A1:L1").AutoFilter field:=12, Criteria1:=code, Operator:=xlFilterValues
End If
End Sub
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
