オートフィルタで「・・で始まる」数値の抽出方法

質問

VBAでオートフィルタを使用して「95」から始まるデータを抽出して、そのデータを1行目の項目行を省いて別シートの最終行に貼り付けするマクロを作成していますが、上手くいかない部分があり困っています。

オートフィルタはセルに入っている値が数値データの場合は「○○で始まる」検索オプションが使えない仕様とのことです。
https://support.microsoft.com/ja-jp/kb/170230
数字をテキスト形式に変換すれば文字列として扱われるので、上記の検索オプションが使えるとのことで数値が入った列を全て文字列にしようとしましたが、上手くいきません。

下記のコードが一部抜粋のコードで、A列にオートフィルタで抽出したい5桁の数値が入っているとします。

元シート(移動先シートも同じような構成でデータが入っている)
A　　　　B　　　C　　　D　　　　E
ID　　　品名　　単価　　数量　　金額
92153　りんご　100　　　10　　　1000
95235　ばなな　150　　　15　　　2250
95589　みかん　50　　　20　　　1000
87896　ぶどう　200　　　7　　　1400

Dim LastRow As Long, mySt(1) As Worksheet

ActiveWorkbook.Worksheets("元シート").Activate

Set mySt(0) = Worksheets("元シート")
Set mySt(1) = Worksheets("移動先シート")

Columns("A:A").Select
Selection.NumberFormatLocal = "@"　'←選択列を文字列にしようとしたが上手くいかず

With mySt(0)
LastRow = .Cells(Rows.Count, 1).End(xlUp).Row
With .Range(.Rows(1), .Rows(LastRow))
.AutoFilter Field:=1, Criteria1:="95*", Operator:=xlAnd
With .SpecialCells(xlCellTypeVisible)
.Copy mySt(1).Rows(1)
End With
End With
End With

また、オートフィルタで抽出したデータをコピーして、既にデータが入っている移動先シートの最終行に貼り付けたいのですが、上手くいかず、2行目に貼り付けられてしまいます。
移動先シートの最終行の取得と貼付け方法が検索してもよく分からず困っています。

2点につきまして、分かる方がいましたら教えて頂けますと助かります。
よろしくお願いいたします。

回答No.7

kagakusuki

回答No.2様や回答No.3様の様に、For Each ～ Nextの様な繰り返し処理を使っても構わないという事であれば、別に

繰り返し処理でデータを1つずつ文字列に変換
　　↓
オートフィルタで抽出
　　↓
抽出データをコピーして別シートに貼り付け
　　↓
元データを数値に戻す

などという面倒な事をしなくても、単純に
「繰り返し処理でデータを1つずつチェックして行って、『95』から始まるものが見つかれば、その都度1行ずつ別シートにデータ(と表示形式)を転記する」
というやり方をすれば済む話なのではないでしょうか？

Sub QNo9229485_オートフィルタで_○○で始まる_数値の抽出方法()

Const ItemRow = 1
Const SearchColumn = "A"
Const OrigColumns = "A:E"
Const PasteColumn = "A"
Dim LastRow As Long, mySt(1) As Worksheet, c(2) As Range, myRows As String

Set mySt(0) = Worksheets("元シート")
Set mySt(1) = Worksheets("移動先シート")

With mySt(0)
LastRow = .Range(SearchColumn & Rows.Count).End(xlUp).row
If LastRow <= ItemRow Then
MsgBox "処理すべきデータが見当たりませんません。" & vbCrLf _
& "マクロを終了します。", vbExclamation, "データ無し"
Exit Sub
End If

Application.ScreenUpdating = False
Application.Calculation = xlManual

For Each c(0) In .Range(SearchColumn & ItemRow + 1 & ":" & SearchColumn & LastRow)
If c(0).Value Like "95*" Then
Set c(1) = Intersect(c(0).EntireRow, .Range(OrigColumns))
Set c(2) = mySt(1).Range(PasteColumn & Rows.Count).End(xlUp).Offset(1) _
.Resize(1, c(1).Columns.Count)
c(2).Value = c(1).Value
c(2).NumberFormatLocal = c(1).NumberFormatLocal
End If
Next
End With

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

End Sub

回答No.6

kkkkkm

> With .SpecialCells(xlCellTypeVisible)
> .Copy mySt(1).Rows(1)
> の.Rows(1)の設定の仕方が悪いのでしょうか・・

Rows(1)だと1行目を指定してますので1行目に貼り付けられています。元シートの1行目(項目名)からコピーしてますから、貼り付け先の1行目は変わらないために2行目から貼り付いているように見えるだけです。

その部分で最終行に貼り付けたい場合は、元シートの2行目からコピーして移動先シートの最終行の後に貼り付けになりますので、以下のように変更してみればいかがでしょう。

With mySt(0)
LastRow = .Cells(Rows.Count, 1).End(xlUp).Row
.AutoFilterMode = False
.Range(.Rows(1), .Rows(LastRow)).AutoFilter _
Field:=1, Criteria1:="95*", Operator:=xlAnd
.Range(.Rows(2), .Rows(LastRow)).SpecialCells(xlCellTypeVisible).Copy _
mySt(1).Rows(mySt(1).Cells(Rows.Count, 1).End(xlUp).Row + 1)
End With

回答No.5

Chiquilin

桁が決まっているなら 数値で条件指定すればいいだけだと思います。
後「オートフィルタ」に拘りがないなら フィルタの詳細設定を使えばいいです。

F1に「95」
F2に「=LEFT(A2,2)=F$1&""」

と入れて検索条件範囲を「F1:F2」に。

補足

桁数は変化します。
最初の質問に記載していなくて申し訳ありません。

回答No.4

kkkkkm

No3です。

Trimは不要でした。

c.Value = Trim(CStr(c.Value))
↓
c.Value = CStr(c.Value)

回答No.3

kkkkkm

文字列にするのは以下のコードでいかがでしょう。

Dim c As Range

Columns("A:A").Select
Selection.NumberFormatLocal = "@"
For Each c In Range(Cells(2, 1), Cells(Rows.Count, 1).End(xlUp))
c.Value = Trim(CStr(c.Value))
Next

2行目に貼り付けられる件が、何もデータがない場合1行目に貼り付けたいのに2行目になるという事でしたら
Cells(Rows.Count, 1).End(xlUp).Row
は1行目にデータがない場合には1を返しますので(0行目があり得ないため)取得した最終行に1を加算した行目に貼り付けると2行目になってしまいます。
既に1行目以降数行分データがあるにも関わらず2行目に貼り付けられる場合、最終行を取得するシートの指定が間違っている可能性があります。

補足

回答ありがとうございます。
教えて頂いたサンプルコードで数値データを文字列データに変換できることが確認できました！
No.2さんのコードでも同じことができますが、シンプルで見やすいですね。

移動先シートの件は、1行目には必ず項目名を入れるようにしてあります。
ただ、最終行の取得とその直下の行にデータを貼り付ける動作が上手くいかず、必ず2行目に貼り付けられてしまいます。
With .SpecialCells(xlCellTypeVisible)
.Copy mySt(1).Rows(1)
の.Rows(1)の設定の仕方が悪いのでしょうか・・
それともシートの指定方法が不味いのでしょうか

回答No.2

chie65535

「必ず５桁」ってのが保証されているなら

「95000」「以上」
AND
「96000」「より小さい」

というフィルタを設定すれば良いのでは？

もし「95も950も9500も95000も抽出したい」って場合は、どこか別の作業列に

=LEFT(A1,2)

って言う式を書いて、下まで必要なだけコピーして、その作業列の値が「95」になっている物だけを抽出する必要があります。

＞数字をテキスト形式に変換すれば文字列として扱われるので、上記の検索オプションが
＞使えるとのことで数値が入った列を全て文字列にしようとしましたが、上手くいきません。

「数字をテキスト形式に変換すれば」の意味は「データそのものを文字列に変換する」って意味です。

＞Selection.NumberFormatLocal = "@"　'←選択列を文字列にしようとしたが上手くいかず

これは「表示形式を文字列にしようとしているだけ」であって「データそのものは何も変わってない」です。

「データそのものを文字列にする」のであれば

Dim Rg As Range
Set Rg = Range("A:A")
For Each tg In Rg
If IsEmpty(tg) Then Exit For
If (VarType(tg) >= vbInteger And VarType(tg) <= vbCurrency) Or VarType(tg) = vbDecimal Then
tg.Value = "'" & tg.Value
End If
Next

というプログラムで「データそのものを文字列値に置き換えする」必要があります。

こうすれば「95」「で始まる」をオートフィルタに設定可能です。

補足

回答ありがとうございます。
質問内容に書いていませんでしたが95で始まる数字は桁数が変わる場合があります。ですので、数字の範囲で以上以下でちょっと難しかったです。
データ自体を文字列に変換するやり方の解説ありがとうございます。
他の方の回答のコードでも同じことができるので、色々なアプローチの方法があるんだなと勉強になりました。
文字列に変換できましたので、オートフィルタで「95で始まる」検索ができるようになりました。

回答No.1

shintaro-2

>数字をテキスト形式に変換すれば文字列として扱われるので、上記の検索オプションが使えるとのことで数値が入った列を全て文字列にしようとしましたが、上手くいきません。

90000以上
95000以上
95500以上とか
数値で指定すればよいのでは？

補足

実務で使うデータは桁数が変わるため数値の以上以下だと関係ないデータまで引っ張ってしまう可能性がある気がしました。
桁数が変わっても95で始まる数字のみをピックアップしたいのが正確なやりたいことでした。