VBA 数字をフィルターで表示

いつもお世話になってます。
Private Sub CommandButton2_Click()
Sheet2.Select
With ActiveSheet
Range("A3:BB3").Select
Selection.AutoFilter
If UserForm2.ComboBox4.Value <> "" Then
Selection.AutoFilter Field:=5, Criteria1:=UserForm2.ComboBox4.Value
End If

.Range("A3").CurrentRegion.SpecialCells(xlCellTypeVisible).Copy Sheet5.Range("A1")
.AutoFilterMode = False
End With
End sub
としています。
ComboBox4は011や022や555とかが入ります。
Field:=5は、10桁の数字(文字列にしてあります)で6桁目から8桁目までをComboBox4から選びフィルターをかけてシート5にコピペしたいのですが表示されません。
何が間違っているのでしょうか？

No.2 ベストアンサー 回答者： fujillin 回答日時： 2021/01/19 23:56

No1です

＞無理なんですね。
無理とは言っていません。
「AutoFilterだけで一発で求めるのは難しい」というだけです。
No1の回答は実現方法を示したつもりですけれど、あまり通じてはいないようなので…

シート等の各種状況で不明な点が多いので、きちんとは書けませんが、以下は、最後に記しておいた方法の一例です。
※ 「Sheet2.Select」のSheet2等はコード名なので、通常のシート名とは異なる可能性があります。
　シートの指定の方法を変えてありますので、実際のシート名に調整してください。
　（Sheet2、Sheet5の2か所）　
※ ご提示のコードから、A3のCurrentRegionで対象範囲が取得できるものと仮定しています。

Dim rng As Range, c As Range, u As Range
Const testStr = "555" ' ←抽出用の仮の値

Set rng = Worksheets("Sheet2").Range("A3").CurrentRegion
For Each c In rng.Columns(5).Cells
　If Mid(c.Text, 6, 3) = testStr Then
　　If u Is Nothing Then Set u = c Else Set u = Union(u, c)
　End If
Next c

If Not u Is Nothing Then
　Intersect(u.EntireRow, rng).Copy Worksheets("Sheet5").Range("A1")
End If

この回答へのお礼

ありがとうございます。
ご指摘ありがとうございます。*文字列*のところスルーしてしまい申し訳ありません。
Sheet２，Sheet5は2番目と5番目というシートを支持していまして。

間違っていたらすみません。ご指示いただいたものはフィルターとは違う方法でｃというものに代入し、それを抽出する感じですか？

お礼日時：2021/01/20 13:36

No.1 回答者： fujillin 回答日時： 2021/01/19 08:00

こんにちは

抽出条件にマッチするものが残されるのが通常だからでしょうね。

部分一致で抽出したければ、条件を「*文字列*」などとすれば、「文字列」が含まれる項目をヒットさせることはできますが、桁数の位置指定まではできません。

空き列を一時的な作業列に使って、関数などで6～8桁目だけを抽出して、その列をキーに抽出してから作業列を削除するような方法をとるしかなさそうな気がします。
あるいは、AutoFilterを使わずに、各行を直接判断してゆく方法にするとか…

この回答へのお礼

ありがとうございます。無理なんですね。
Mid関数で抜き出し、新たな列を設けそちらを表記させてみます。

お礼日時：2021/01/19 17:38