【エクセルVBA】指定した文字列の抽出方法について教えてください。

質問

下記のように、"AAA-1"という文字列を指定しシート1のあるレンジを検索して見つかったらその下のセルのデーターをシート2にコピーしてやり、次に"AAA-2"という文字列を指定して同じように文字列を変えて繰り返し抽出したいのですがこの方法では抽出して欲しくない"AAA-11"や"AAA-12"も抽出されてしまいます。数字の文字数が規定ができれば解決しそうですがいまいちわかりません。アドバイスよろしくお願いいたします。

IDNo = "AAA-1"
With Worksheets("Sheet1").Range("A1:P1")
Set IDchoice = .Find(What:=IDNo, LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False, MatchByte:=False)
If Not IDchoice Is Nothing Then
FirstAddress = IDchoice.Address
Do
Sheets("DATA2").Select
Cells(IDchoice.Row+1, IDchoice.Column).Copy
Sheets("Sheet2").Select
Cells(1, 1).PasteSpecial
・
・

回答No.6

Wendy02 · ベストアンサー

こんにちは。

そのコードが、途中までですが、少し、コードの上半分と下半分の整合性がおかしいなって思いますが、例えば、以下のようにしたらよいと思います。

ただし、
abcAAA-1a
は、OKとしますが、abcAAA-11a は、NGとした場合です。

上半分で、Worksheets("Sheet1")　となっていますから、下も、Sheets("DATA2")ではなく、Worksheets("Sheet1")にしました。 Like演算子で、仕分けしました。

If Not IDchoice Is Nothing Then
　 FirstAddress = IDchoice.Address
　 Do
　　If Not IDchoice.Value Like "*" & IDNo & "#*" Then
　　i = i + 1
　　Worksheets("Sheet1").Cells(IDchoice.Row + 1, IDchoice.Column).Copy _
　　Worksheets("Sheet2").Cells(i, 1)
　　End If
　　Set IDchoice = .FindNext(IDchoice)
　 Loop Until IDchoice Is Nothing Or IDchoice.Address = FirstAddress
End If

'--------------------------------------

お礼

こんにちは、Like "*" & IDNo & "#*" の記述で解決できました。#は英数字一文字ということは自分で調べて分かっていたのですが記述方法がわからずうまく動きませんでした。本当にありがとうございました。また沢山の方に親切に回答いただき感謝しています。質問だけでなく自分の得意分野で回答をしてお礼の還元をしたいと思います。

回答No.10

KenKen_SP

#3 です。連続で本当に申し訳ありません。

お恥ずかしい限りですが、#5 のレスへ返信しておきます。
InStr 関数で切り分けするなら、次のようになります。

　lngPos = InStr(1, IDchoice.Value, IDNo) + Len(IDNo)
　If IsNumeric(Mid$(IDchoice.Value, lngPos, 1)) Then

Len 関数の後の +1 が余計でした。切り分け方法は Wendy02 さんの
ものが良いと思いますが、別方法として「こんな方法もあるんだ」
ぐらいで考えていただけると幸いです。

tetsufumosan 様、他回答者の皆様、お騒がせして申し訳ありません。
穴に入ってきますm(__)m

お礼

沢山の方に親切に回答いただき感謝しています。質問だけでなく自分の得意分野で回答をしてお礼の還元をしたいと思います。

回答No.9

KenKen_SP

#3 です。

ひとつ下、、は Row や Column を調べてセルを決めるより、単純に
OFFSET を使う方がコードがすっきりします。

切り分けの方法は InStr関数 を使うより、Wendy02 さんのものの方
すっきりとして良い方法だと思います。

一応、実行できる形でコード全体をアップしてみます。

Sub Test()

　　Dim rngSA　　As Range
　　Dim IDchoice As Range
　　Dim IDNo　　 As String
　　Dim firstAddress As String

　　IDNo = "AAA-1"

　　'検索範囲
　　Set rngSA = Worksheets("Sheet1").Range("A1:P1")
　　'初回検索
　　Set IDchoice = rngSA.Find( _
　　　　What:=IDNo, _
　　　　LookIn:=xlValues, _
　　　　LookAt:=xlPart, _
　　　　MatchByte:=False)

　　'初回検索の結果、セルが見つからない
　　If IDchoice Is Nothing Then
　　　　MsgBox "該当データはありません", vbInformation
　　　　'プログラム終了処理へ飛ばす
　　　　GoTo Terminate
　　End If

　　'初回検索の結果、セルが見つかったとき
　　firstAddress = IDchoice.Address
　　Do
　　　　'部分一致で検索されたセルの値をチェック
　　　　If Not IDchoice.Value Like "*" & IDNo & "#*" Then
　　　　　　'IDchoice のひとつ下のセルの値を転記
　　　　　　Sheets("Sheet2").Cells(1, 1).Value = _
　　　　　　　　IDchoice.Offset(1, 0).Value
　　　　End If
　　　　Set IDchoice = rngSA.FindNext(IDchoice)
　　Loop Until IDchoice Is Nothing Or IDchoice.Address = firstAddress

Terminate:
　　Set IDchoice = Nothing
　　Set rngSA = Nothing

End Sub

回答No.8

noname#112806

#1です。
#3への補足を受けて思ったのですが
IDNo = "AAA-1"
を
IDNo = "AAA-1-"
とすればいいのではないですか？

お礼

沢山の方に親切に回答いただき感謝しています。質問だけでなく自分の得意分野で回答をしてお礼の還元をしたいと思います。

回答No.7

noname#112806

#1です。
#3への補足を受けて思ったのですが
IDNo = "AAA-1"
を
IDNo = "AAA-1-"
とすればいいのではないですか？

回答No.5

KenKen_SP

#3,4 です。

重ねて失礼しました。

　If IsNumeric(Mid$(IDchoice.Value, lngPos, 1)) Then

は

　If Not IsNumeric(Mid$(IDchoice.Value, lngPos, 1)) Then

ですね、、、穴があったら入りたい、、、

お礼

親切に何度も回答してくださりありがとうございます。早速試してみましたが"AAA-1"で指定しても"AAA-11"や"AAA-12"も抽出されてしまいます。

回答No.4

KenKen_SP

#3 です。ごめんなさい。

Nothing してはダメですね。Do ループの中で値の判定処理とすべき
でした。#3 はボツです。

Do
　lngPos = InStr(1, IDchoice.Value, IDNo) + Len(IDNo) + 1
　If IsNumeric(Mid$(IDchoice.Value, lngPos, 1)) Then

　　　(処理）ここに挟む

　End If
Loop Until (条件句）

回答No.3

KenKen_SP

こんにちは。KenKen_SP です。

部分一致検索でヒットしたセルの値を調べて、該当しなければ

　Set IDchoice = Nothing

すれば? 例えば、AAA-1 のあとが数字だったら「該当しない」とする
なら、

　Set IDchoice = .Find( _
　　　What:=IDNo, _
　　　LookIn:=xlValues, _
　　　LookAt:=xlPart, _
　　　MatchByte:=False)
　'追加
　lngPos = InStr(1, IDchoice.Value, IDNo) + Len(IDNo) + 1
　If IsNumeric(Mid$(IDchoice.Value, lngPos, 1)) Then
　　　Set IDchoice = Nothing
　End If
　'以下オリジナル
　If Not IDchoice Is Nothing Then
　（略）

InStr 関数と Len 関数 で AAA-1 に続く次の文字が数字かどうか調べ
て、数字だったら Nothing してます。こうすると、

AAA-1 はヒットするけれど、AAA-11 はヒット（正確にはヒットしても
Nothing する）しなくなると思います。

試してないので、アイディアとして。他には、正規表現を使うとか?

IDNo の具体例を数個ご提示いただけると、いろんな方法がレスされる
と思います。

補足

回答ありがとうございます。IDNo の具体例としては下記の通りです。
FANAAA-1-1.csv←これを抽出しようと"AAA-1"と設定すると
下のIDNoもヒットしてしまいます。
LOADAAA-11-2.csv
SECAAA-12OLD-3.csv

回答No.2

mshr1962

>"AAA-1"の前後にもいろいろな文字列がつくので"xlWhole"で"完全に一致"にすると検索にひっかからなくなるのでどうしたらよいものかと
スペース・コロン[:]・アンダーバー[_]等の特定の文字列を数字の最後に付加するか、数字部分の桁数を揃えることをお奨めします。
これなら"AAA-1 ","AAA-1:","AAA-1_","AAA- 1","AAA-01"等で一致できますよね。

補足

実はその方法も考えたのですが、あくまで特定の文字列は"AAA-1"のみでその前後は不特定の文字列がつくので都合がよくありません。補足不足で申し訳ありません。

回答No.1

noname#112806

実際に試していないので間違っていたらすみません。
>Set IDchoice = .Find(What:=IDNo, LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False, MatchByte:=False)
この部分で検索していると思うのですが「LookAt:=xlPart」は部分一致なので一部分でも一致していれば抽出されます。
xlPartではなくxlWholeを指定すれば完全に一致する値だけを検索します。

補足

こんにちは、回答ありがとうございます。質問に補足しますと"AAA-1"の前後にもいろいろな文字列がつくので"xlWhole"で"完全に一致"にすると検索にひっかからなくなるのでどうしたらよいものかと頭を悩ませております。