今、2つのブック(bookA,bookB)があります。
bookAで、スペース等を含む指定の文字列(例えば「りんご ごりら」など)を、AT列で検索します。
該当したセルに来ましたら、左に5列(AO列)、下に1セル移動した場所のセルをコピーしまして。
そのコピーしたデータでbookBのG列を検索し、該当するセル(完全一致)がありましたら。
そのセルから右に5列移動(L列)、上に1セル移動した場所のセルと、隣のM列のセル、2つのセルをコピーします。
最後に、bookAで再度、指定の文字列(りんご ごりら)を検索し、先ほどコピーした2つのセルを、右に5列移動(AT列)、上に1セル移動した場所に貼り付けます。
こういった処理を6万行ぐらい行いたいのですが…マクロ等で可能であればお教えいただけますと幸いです。
よろしくお願い致します。
自動化したい作業のイメージを再確認です。
bookA の AT~AU列に間違ったデータがあって、それを bookB の L~M列のデータで書き換えたい。
正しいデータは、bookA の一行下の AO列と bookB の G列とが一致する行で、その一行上のもの。
... | AO | ... | AT | AU | ... |
---|---|---|---|---|---|
りんごごりらへび | こぶたたぬき柴犬 | ||||
ST-010203 | |||||
... | G | ... | L | M | ... |
---|---|---|---|---|---|
りんごごりららっぱ | こぶたたぬき狐 | ||||
ST-010203 |
... | AO | ... | AT | AU | ... |
---|---|---|---|---|---|
りんごごりららっぱ | こぶたたぬき狐 | ||||
ST-010203 | |||||
作業のイメージがあってるとして、こんな感じでどうでしょうか。
Const REF_BOOK = "D:\data\bookB.xlsx" ' bookB のフルパス Sub copy_data() search_word = "りんごごりら" ' 検索ワード target_column = 46 ' AT列 ref_column = 7 ' G列 Set this_book = ActiveWorkbook Set bookB = Workbooks.Open(REF_BOOK) this_book.Activate Set ref_sheet = bookB.Sheets(1) ' bookB の 1番目のシート last_row = Cells(Rows.Count, target_column).End(xlUp).Row last_row_b = ref_sheet.Cells(Rows.Count, ref_column).End(xlUp).Row For r = 1 To last_row If InStr(Cells(r, target_column).Value, search_word) > 0 Then Key = Cells(r + 1, target_column - 5).Value rr = -1 For r2 = 1 To last_row_b If ref_sheet.Cells(r2, ref_column).Value = Key Then rr = r2 Exit For End If DoEvents Next If rr <> -1 Then Set s_range = ref_sheet.Range(ref_sheet.Cells(rr - 1, ref_column + 5), ref_sheet.Cells(rr - 1, ref_column + 6)) Set d_range = Range(Cells(r, target_column), Cells(r, target_column + 1)) s_range.Copy d_range End If End If DoEvents Next bookB.Close SaveChanges:=False End Sub
上記のマクロは、bookA の標準モジュールにはりつけてください。
マクロ中の上記を適切なものに変えて、bookA の修正したいシートを選択した状態で、サブルーチン copy_data を実行してください。
# 念のため書いておきますが、バックアップを取ってから実行してください
bookB の、どのシートを見るかという指定がなかったので、一番目のシートから探すようにしています。
処理が終了すると、bookB は自動的に閉じます。
bookB に変更点があっても、無視して閉じるようにしてあるので、bookB に手を加えた場合には、注意してください。
検索対象の AT列の文字の長さにもよりますが、bookA の行数というよりは置き換えるデータの数で処理時間が決まってくると思うので、それほど時間はかからずに終了すると思います。
上記のマクロは、bookA で該当データが見つかるたびに、bookB を探しているのですが、bookB のシートの行数が多いと遅いかもしれません。
コメントで、修正するデータは一種類だけのようなことを書かれていたので、bookB の正しいデータを覚えておくようにしたのが、次のマクロです。
Const REF_BOOK = "D:\data\bookB.xlsx" ' bookB のフルパス Sub copy_data2() search_word = "りんごごりら" ' 検索ワード target_column = 46 ' AT列 ref_column = 7 ' G列 Set this_book = ActiveWorkbook Set bookB = Workbooks.Open(REF_BOOK) this_book.Activate Set ref_sheet = bookB.Sheets(1) ' bookB の 1番目のシート last_row = Cells(Rows.Count, target_column).End(xlUp).Row last_row_b = ref_sheet.Cells(Rows.Count, ref_column).End(xlUp).Row prev_key = "" Set ref_range = Nothing For r = 1 To last_row If InStr(Cells(r, target_column).Value, search_word) > 0 Then Key = Cells(r + 1, target_column - 5).Value If prev_key <> Key Then Set ref_range = Nothing For r2 = 1 To last_row_b If ref_sheet.Cells(r2, ref_column).Value = Key Then prev_key = Key Set ref_range = ref_sheet.Range(ref_sheet.Cells(r2 - 1, ref_column + 5), ref_sheet.Cells(r2 - 1, ref_column + 6)) Exit For End If DoEvents Next End If If Not ref_range Is Nothing Then Set d_range = Range(Cells(r, target_column), Cells(r, target_column + 1)) ref_range.Copy d_range End If End If DoEvents Next bookB.Close SaveChanges:=False End Sub
こちらは、必要ないかもしれませんが、一応おいときます。
「スペース等を含む指定の文字列(例えば「りんご ごりら」など)」は、どうやって指定しますか?
続く「を、AT列で検索します」は、完全一致ではない?
空白で区切られた文字のどれかが含まれている行があれば、そこが最初の目印でしょうか。
# bookB の G列を探すときには、わざわざ「完全一致」と記載されているので。
「最後に、bookAで再度、指定の文字列(りんご ごりら)を検索し」は、最初に探した位置を覚えておけば、十分ですか。
それとも、最初に探した位置から更に下方向に探しに行きますか?
「こういった処理を6万行ぐらい行いたいのですが」
そこまでに書かれた内容だと、最終的に bookA のどこかの行の L~M列の値を、bookB のどこかの行の AT~AU列に貼り付けて終了のように見えるのですが、6万行くらいというのは、何度も自動で繰り返したい、という気持ちの表れでしょうか。
最初に検索する文字列をどうやって指定するかにもかかわってくると思いますが。
>>「スペース等を含む指定の文字列(例えば「りんご ごりら」など)」は、どうやって指定しますか?
すみません、半角スペースは無しで問題ありません。
例えば、「りんごごりら」という文字列があるセルを、変更したいというのが目的です。
指定の文字列=内容が重複している文字列、のことで、これをbookBのデータから引っ張り、貼り付けて修正を行いたいということです。
>>「最後に、bookAで再度、指定の文字列(りんご ごりら)を検索し」は、最初に探した位置を覚えておけば、十分ですか。
それとも、最初に探した位置から更に下方向に探しに行きますか?
はい、最初に探した位置でヒットすれば問題ありません。おそらく同じデータは2つと無いと思いますので。
>>そこまでに書かれた内容だと、最終的に bookA のどこかの行の L~M列の値を、bookB のどこかの行の AT~AU列に貼り付けて終了のように見えるのですが、6万行くらいというのは、何度も自動で繰り返したい、という気持ちの表れでしょうか。
6万行検索を行いたいのは、bookAのAT列になります。AT列に「りんごごりら」というデータが300個ぐらいありまして、最後の300個目が大体5万9000行付近です。
そのデータ及び隣りのAU列のデータは重複データなので、bookBの該当するL列・M列のデータを貼り付けられたらいいな・・・と、考えております。
質問がわかりにくく恐縮です。
よろしくお願い致します。
>>
今、2つのブック(bookA,bookB)があります。
bookAで、指定した文字列(例えば「りんご ごりら」など)を、AT列で検索します。
その文字列を含むセル(部分一致)に来ましたら、左に5列(AO列)、下に1セル移動した場所のセルの値を記憶します。
その値でbookBのG列を検索し、該当するセル(完全一致)がありましたら、
そのセルから右に5列移動(L列)、上に1セル移動した場所のセルと、隣のM列のセル、2つのセルをコピーします。
最後に、bookAで、指定の文字列(りんご ごりら)があるセルの、右に5列移動(AT列)、上に1セル移動した場所に貼り付けます。
こういった処理を6万行ぐらい行いたいのですが…
<<
これで、イメージはあってるでしょうか?
あと、6万行ほど、について、もう一度 質問を。
>6万行検索を行いたいのは、bookAのAT列になります。AT列に「りんごごりら」という
>データが300個ぐらいありまして、最後の300個目が大体5万9000行付近です。
>そのデータ及び隣りのAU列のデータは重複データなので、bookBの該当するL列・M列の
>データを貼り付けられたらいいな・・・と、考えております。
bookA のAT列に「りんごごりら」が含まれるデータは何種類もあって(「りんごごりららっぱ」や「りんごごりららくだ」とか)、それらの全てについて、同じような処理をやりたい、ということで良いんですよね。
# 住所からの郵便番号とか、そんなのかな?
もしあってるなら、先の文章の最後は、こんな感じになるでしょうか。
>>
こういった処理を、bookA の AT列で該当する全てのデータについて行いたいです。
# bookA には、6万行ぐらいのデータがあります
<<
はい、合っております。私ではどう考えても自動化が難しい複雑な処理ではありますが、もし可能でしたら・・・お教えいただけますと幸いです。
>>bookA のAT列に「りんごごりら」が含まれるデータは何種類もあって(「りんごごりららっぱ」や「りんごごりららくだ」とか)、それらの全てについて、同じような処理をやりたい、ということで良いんですよね。
# 住所からの郵便番号とか、そんなのかな?
これに関しては、すみません、記載が曖昧で恐縮です。
「りんごごりら」1つのみです。それがAT列に300個ぐらい重複してある状態ので、正しいデータを貼り付けたいです。bookBがシステムからエクスポートした売上データ、bookAがオリジナルで作成している資料みたいな感じです。
途中までは手動で行っていたのですが、時間がかかりまして・・・良い方法があれば、と思い質問させていただきました。よろしくお願いいたします。
バリエーションがあるわけじゃないけど、完全一致じゃなくて、部分一致で探したい、ってことで良いですか?
# ま、この辺は後でも調整できるか。