Excelで変換できなかったデータをうまく貼り付け直したい

今、2つのブック(bookA,bookB)があります。
bookAで、スペース等を含む指定の文字列(例えば「りんご ごりら」など)を、AT列で検索します。
該当したセルに来ましたら、左に5列(AO列)、下に1セル移動した場所のセルをコピーしまして。
そのコピーしたデータでbookBのG列を検索し、該当するセル(完全一致)がありましたら。
そのセルから右に5列移動(L列)、上に1セル移動した場所のセルと、隣のM列のセル、2つのセルをコピーします。

最後に、bookAで再度、指定の文字列(りんご ごりら)を検索し、先ほどコピーした2つのセルを、右に5列移動(AT列)、上に1セル移動した場所に貼り付けます。
こういった処理を6万行ぐらい行いたいのですが…マクロ等で可能であればお教えいただけますと幸いです。

よろしくお願い致します。

回答の条件
  • 1人10回まで
  • 13歳以上
  • 登録:2017/10/09 17:45:11
  • 終了:2017/10/13 08:15:28

ベストアンサー

id:a-kuma3 No.1

a-kuma3回答回数4619ベストアンサー獲得回数19552017/10/12 11:27:46

ポイント3000pt

自動化したい作業のイメージを再確認です。

bookA の AT~AU列に間違ったデータがあって、それを bookB の L~M列のデータで書き換えたい。
正しいデータは、bookA の一行下の AO列と bookB の G列とが一致する行で、その一行上のもの。

bookA

... AO ... AT AU ...
         
    りんごごりらへび こぶたたぬき柴犬 
 ST-010203      
         


bookB

... G ... L M ...
         
    りんごごりららっぱこぶたたぬき狐  
 ST-010203      


処理実行後の bookA

... 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 の標準モジュールにはりつけてください。

  • bookB のフルパス (REF_BOOK)
  • AT列を検索する語句 (search_word)

マクロ中の上記を適切なものに変えて、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

こちらは、必要ないかもしれませんが、一応おいときます。

id:moon-fondu

a-kuma3さんすごいです、天才的です!
人間の手作業がこんな風に自動化できるなんて、驚きです。
両方とも実行してみましたが、どちらも所要時間5分ぐらいでした。
手作業だとかなり時間がかかっていましたので、助かります。
ありがとうございました。

2017/10/13 08:12:40
  • id:a-kuma3
    ちょっと分からないことがみっつあります。

    「スペース等を含む指定の文字列(例えば「りんご ごりら」など)」は、どうやって指定しますか?
    続く「を、AT列で検索します」は、完全一致ではない?
    空白で区切られた文字のどれかが含まれている行があれば、そこが最初の目印でしょうか。
    # bookB の G列を探すときには、わざわざ「完全一致」と記載されているので。

    「最後に、bookAで再度、指定の文字列(りんご ごりら)を検索し」は、最初に探した位置を覚えておけば、十分ですか。
    それとも、最初に探した位置から更に下方向に探しに行きますか?

    「こういった処理を6万行ぐらい行いたいのですが」
    そこまでに書かれた内容だと、最終的に bookA のどこかの行の L~M列の値を、bookB のどこかの行の AT~AU列に貼り付けて終了のように見えるのですが、6万行くらいというのは、何度も自動で繰り返したい、という気持ちの表れでしょうか。
    最初に検索する文字列をどうやって指定するかにもかかわってくると思いますが。
  • id:moon-fondu
    a-kuma3さん、いつもありがとうざいます。

    >>「スペース等を含む指定の文字列(例えば「りんご ごりら」など)」は、どうやって指定しますか?

    すみません、半角スペースは無しで問題ありません。
    例えば、「りんごごりら」という文字列があるセルを、変更したいというのが目的です。
    指定の文字列=内容が重複している文字列、のことで、これをbookBのデータから引っ張り、貼り付けて修正を行いたいということです。

    >>「最後に、bookAで再度、指定の文字列(りんご ごりら)を検索し」は、最初に探した位置を覚えておけば、十分ですか。
    それとも、最初に探した位置から更に下方向に探しに行きますか?

    はい、最初に探した位置でヒットすれば問題ありません。おそらく同じデータは2つと無いと思いますので。

    >>そこまでに書かれた内容だと、最終的に bookA のどこかの行の L~M列の値を、bookB のどこかの行の AT~AU列に貼り付けて終了のように見えるのですが、6万行くらいというのは、何度も自動で繰り返したい、という気持ちの表れでしょうか。

    6万行検索を行いたいのは、bookAのAT列になります。AT列に「りんごごりら」というデータが300個ぐらいありまして、最後の300個目が大体5万9000行付近です。
    そのデータ及び隣りのAU列のデータは重複データなので、bookBの該当するL列・M列のデータを貼り付けられたらいいな・・・と、考えております。

    質問がわかりにくく恐縮です。
    よろしくお願い致します。
  • id:a-kuma3
    コメントを受けて、質問の文章をちょっと書き換えました。
    >>
    今、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万行ぐらいのデータがあります
    <<
  • id:moon-fondu
    >>これで、イメージはあってるでしょうか
    はい、合っております。私ではどう考えても自動化が難しい複雑な処理ではありますが、もし可能でしたら・・・お教えいただけますと幸いです。

    >>bookA のAT列に「りんごごりら」が含まれるデータは何種類もあって(「りんごごりららっぱ」や「りんごごりららくだ」とか)、それらの全てについて、同じような処理をやりたい、ということで良いんですよね。
    # 住所からの郵便番号とか、そんなのかな?

    これに関しては、すみません、記載が曖昧で恐縮です。
    「りんごごりら」1つのみです。それがAT列に300個ぐらい重複してある状態ので、正しいデータを貼り付けたいです。bookBがシステムからエクスポートした売上データ、bookAがオリジナルで作成している資料みたいな感じです。

    途中までは手動で行っていたのですが、時間がかかりまして・・・良い方法があれば、と思い質問させていただきました。よろしくお願いいたします。
  • id:a-kuma3
    >「りんごごりら」1つのみです。それがAT列に300個ぐらい重複してある状態ので、正しいデータを貼り付けたいです。
    バリエーションがあるわけじゃないけど、完全一致じゃなくて、部分一致で探したい、ってことで良いですか?
    # ま、この辺は後でも調整できるか。
  • id:moon-fondu
    はい、部分一致で問題ありません。自動化の域を超えているかもしれませんがもし可能でしたら・・・よろしくお願いします<m(__)m>

この質問への反応(ブックマークコメント)

「あの人に答えてほしい」「この質問はあの人が答えられそう」というときに、回答リクエストを送ってみてましょう。

これ以上回答リクエストを送信することはできません。制限について

絞り込み :
はてなココの「ともだち」を表示します。
回答リクエストを送信したユーザーはいません