【VBA】抽出し，転記するマクロを組んだのですが，余計なモノまで抽出されてしまいます

前提・実現したいこと

別シートから検索し，検索結果を転記する

発生している問題・エラーメッセージ

検索セルに入力した結果が転記はされるのですが，一致ではない（おそらく文字を含む？2文字目まで？）値までも抽出されてしまいます。添付写真は【FCD450】を検索検索したものでｓ

該当のソースコード

Sub Sort材質_抽出転記()

Dim ws01, ws02 As Worksheet
Dim I, M, lRow, mRow As Long
Dim kensaku As String

Set ws01 = Worksheets("FC材質") '転記前総データ
Set ws02 = Worksheets("成分（2020年1月1日~)") '転記先


mRow = ws02.Cells(Rows.Count, "A").End(xlUp).Row 'シート「成分（2020年1月1日~)」の最終行を取得
ws02.Range("A3:P" & mRow + 1).Clear  'シート「成分（2020年1月1日~)」にある前回の結果データをクリアー


kensaku = ws02.Range("B1")  '検索する材質を「kensaku」へ代入
lRow = ws01.Cells(Rows.Count, "A").End(xlUp).Row

mRow = 3  'シート「成分（2020年1月1日~)」に転記する開始行の3行目を設定


For I = 12 To lRow
    
    If ws01.Cells(I, "B") Like "[[]" & kensaku & "[]]*"Then'シート「転記前総データ」から指定した材質に該当するデータを検索する。
        ws02.Range("A" & mRow & ":P" & mRow).Value = ws01.Range("A" & I & ":P" & I).Value  '検索条件に該当する材質をシート「成分（2020年1月1日~)」に転記する
        mRow = mRow + 1  '転記する行に対して＋１加算する。
    End If

Next I

ws02.Range("A3:P" & mRow - 1).Borders.LineStyle = xlContinuous 'シート「成分（2020年1月1日~)」に転記されたデータの最終行まで罫線を引く

End Sub

試したこと

ここに問題に対して試したことを記載してください。

補足情報（FW/ツールのバージョンなど）

ここにより詳細な情報を記載してください。

bebebe_

2021/12/09 08:10

If ws01.Cells(I, "B") Like "[" & kensaku & "]*" Then にて"["を使用しているのは意図はなんですか？検索元のセルが"[FCD450]"と入力されているのであれば If ws01.Cells(I, "B") Like "[[]" & kensaku & "[]]*" Then でうまくいきませんかね

Yassan_

2021/12/09 22:54

ご回答いただきありがとうございます。また，返信が遅くなり申し訳ありません。頂きましたコードに入れ替えたところ，検索欄が0件となり，何も表示されなくなってしまいました，，

行動規範の内容に同意します

回答1件

ベストアンサー

情報が抜け落ちているのでどのようなことに困っているのか良くわかりません......。

おそらくですが、Likeの条件指定が理解できていないような気がします。

VBA
1If ws01.Cells(I, "B") Like "[" & kensaku & "]*"Then

上は修正される前の行ですが、変数kensakuにFCD450を入力した場合、

VBA
1If ws01.Cells(I, "B") Like "[FCD450]*" Then

となることは分かりますか？

Like "[]" という書き方は大体 Like "[A-Z]" , Like "[1-9]" のように
Like "[A-Z]" ⇒ "AからZのアルファベット"の場合、
Like "[1-9]" ⇒ "1から9の数字"の場合、といった判定に使われることが多いです。

Like "[FCD450]" ⇒ "F,C,D,4,5,0のどれか"　という指定になります。
今回は (0文字以上の文字列)がついているので
Like "[FCD450]" ⇒ "F,C,D,4,5,0のどれかから始まる文字列" という指定です。

「FCD450」という文字列に完全一致するデータだけを抜き出したい場合は

VBA
1If ws01.Cells(I, "B") = kensaku Then

と書きます。

「FCD450」という文字列から始まるデータについて抜き出したい場合は

VBA
1If ws01.Cells(I, "B") Like kensaku & "*" Then

と記述します。

自分が転記したくないデータも転記してしまうということでしたので
一度転記の条件を見直してみればいいかもしれません。

#追記。
この回答方法が正しいのか分かりませんでしたが、一応回答いたします。

追加質問

今回はws.2のA-P列を転記するというものでした。
これを，ws.2のA-Bと，R-X列を転記し，A,B,R,S...と詰めて表示する場合，
Rangeの部分に何か加えればいいのでしょうか。

VBA
1'検索条件に該当する材質をシート「成分（2020年1月1日~)」に転記する
2ws02.Range("A" & mRow & ":P" & mRow).Value = ws01.Range("A" & I & ":P" & I).Value

この行の処理を見てください。こちらでデータをws01からws02にコピーしているのは分かりますか？

全体の処理を見ると、変数Iにはws01の入力行(コピーする元の行)が入り、変数mRowにはws02の出力行(コピーする先の行)が入っています。
例えば、mRowに "5" 、I には "15" が入っていたとします。
すると上の行は「ws01の"A15:P15"」を「ws02の"A5:P5"」にコピーする

VBA
1'検索条件に該当する材質をシート「成分（2020年1月1日~)」に転記する
2ws02.Range("A5:P5").Value = ws01.Range("A15:P15").Value

という処理になります。

新しく書きたい処理に置き換えた場合
「ws01の"A15:B15"」を「ws02の"A5:B5"」にコピーする。
「ws01の"R15:X15"」を「ws02の"C5:I5"」にコピーする。
という二つの処理で書くことができます。

VBA
1'検索条件に該当する材質をシート「成分（2020年1月1日~)」に転記する
2ws02.Range("A5:B5").Value = ws01.Range("A15:B15").Value
3ws02.Range("C5:I5").Value = ws01.Range("R15:X15").Value

実際には条件に合わせて変数Iと変数mRowが変更されていくので、

VBA
1'検索条件に該当する材質をシート「成分（2020年1月1日~)」に転記する
2ws02.Range("A" & mRow & ":B" & mRow).Value = ws01.Range("A" & I & ":B" & I).Value
3ws02.Range("C" & mRow & ":I" & mRow).Value = ws01.Range("R" & I & ":X" & I).Value

といった形になります。
ここまで書いてあることが分からなかった場合には、最後のプログラムをコピーしてください。
大変かとは思いますが、学習頑張ってください。

投稿2021/12/10 00:22

編集2021/12/10 05:31