Excelでデータを抽出する方法について

質問

Excel2013で作成されている大きな表があります（最終行が4000位）。そのうちAA列に「A003」「H072」（アルファベットが小文字の場合もあります）など最初の文字がアルファベットで後の3文字は数字の3桁のコードが入っている行を抜き出したいです。
AA列は、空欄のセルもありますし、コードの前や後に「NXE010025021」など別の数字が入っているセルもあります。

アドバイス頂けましたら幸いです。
宜しくお願い致します。

回答No.3

HohoPapa

VBAは使えず、必要な行たちをフィルターで絞り込み
手作業で別シートに複写する対応でよければ、
添付画像を例に

AB2=IF(OR(AND(CODE(AA2)>=97,CODE(AA2)<=122),AND(CODE(AA2)>=65,CODE(AA2)<=90)),"〇","×")
AC2=IF(LEN(AA2)>=4,"〇","×")
AD2=IF(ISERR(VALUE(MID(AA2,2,3))),"×","〇")
AE2=IF(MID(AA2,2,3)=ASC(MID(AA2,2,3)),"〇","×")
AF2=IF(AND(AB2="〇",AC2="〇",AD2="〇",AE2="〇"),"〇","×")

といった式を埋め、必要数下方向に複写し
その後ＡＦ列でフィルターを設定します。

回答No.2

imogasi

既に解答は出ている。出し遅れて、賛成票を投じる的なことで、下記を出します。
ーー
>アドバイス頂けましたら
ないでしょう。このタイプの問題は
（１）文字種の判定
エクセル関数にISNUMBER関数などあるが、ISALFAはない。
そこで正規表現などの力に頼ることになる。
VBAではその簡略機能のLIKEの利用です
（２）抜出し
FILTER関数ができたが、それまではなかった。
関数は処理中間の情報を保持する、「変数」が使えないので、次ステップへ処理をつなぐのがむつかしい。技巧的な関数組み合わせや、配列数式などを使わざるを得ない。
参考　５・３１のOKWAVE質問
INDEX関数SMALL関数を使って空白行を詰める
この「詰める」ということが、関数では意外に難しいのです。同行にIF関数で値が出せる問題なら、FILTER関数が使えるか考えるのも手です。
ーー
以上がアドバイスならぬ、小生の、考えの発端です。
下記VBAは、A-H列(8列)データをK-R列に抜き出してます。
また、条件に合う行は、J列にA列データを出してます（テスト確認用）
これで下記IF文の条件は正しいでしょうか？
このJ列で条件該当列が正しいでしょうかチェックする。
全角のAーZの文字はA列データの先頭に来ると、考慮してません。
条件に合致したデータを作るときの方法は、コピー貼り付けでなく、代入法です。
VBAでも一番やさしい、全行を総当たり方式です。
ーーーー
標準モジュールに
Sub test01()
Dim dt As Variant
k = 1
lr = Range("A100000").End(xlUp).Row
For i = 1 To lr
x = Cells(i, "A")
If Mid(x, 1, 1) Like "[a-zA-Z]" And Mid(x, 2, 3) Like "[0-9][0-9][0-9]" Then
Cells(i, "j") = x　'漏れや余分ないか確認用
dt = Range("A" & i & ":H" & i) '元データをバリアントに
Range(Cells(k, "K"), Cells(k, "R")) = dt
k = k + 1
End If
Next i
End Sub

お礼

ご回答頂き有難うございます。
このような分野にお詳しい事に尊敬します。
私は全くうとく仕事で苦戦しております。
頂いたアドバイスを参考に勉強致します。

回答No.1

NuboChan

最初の１文字がアルファベットで後の3文字が数字の3文字のコードが入っている行を別シートに抜き出す
但し、A003edfなど後ろに文字列が続く場合も対象とする

Option Explicit

Sub ExtractRows()
Dim wsSource As Worksheet
Dim wsTarget As Worksheet
Dim lastRow As Long
Dim i As Long
Dim pattern As String

pattern = "[A-Za-z][0-9][0-9][0-9]*"

Set wsSource = ThisWorkbook.Worksheets("Sheet1")
Set wsTarget = ThisWorkbook.Worksheets("Sheet2")

lastRow = wsSource.Cells(wsSource.Rows.Count, "A").End(xlUp).Row

For i = 1 To lastRow
If wsSource.Cells(i, "AA").Value Like pattern Then
wsSource.Rows(i).Copy wsTarget.Rows(wsTarget.Cells(wsTarget.Rows.Count, "A").End(xlUp).Row + 1)
End If
Next i
End Sub

お礼

ご回答頂き有難うございます。
私はこういった分野にうとく仕事で困る事が多いです。
頂いたアドバイスを参考にさせて頂き勉強したいと思います。