人力検索はてな
モバイル版を表示しています。PC版はこちら
i-mobile

今、2つのExcelのブックがあります。
ブックBのK列には、空白セルとデータが混じってます。

※(行目)|文字列

1|あいうえお
2|(空白セル)
3|(空白セル)
4|(空白セル)
5|かきくけこ
6|(空白セル)
7|(空白セル)
8|さしすせそ



ブックAのZ列には、

1|あいうえおのこと
2|あいうえおについて
3|あいうえおです
4|かきくけこの発声練習
5|かきくけこについて
6|さしすせそです
7|さしすせその勉強
8|さしすせそのアクセント
9|さしすせそについて



のようなデータが入ってます。
この状況にて。
ブックBのK列の空白セルは無視し、データのあるセルの文字列(?とします)を1つずつ、ブックAのZ列にあるかどうか探します。(ブックAのZ列のセルとは完全一致しなくてもよいです)
そして、一致した場合は。
一致した“最初の該当データ”から右に13(AM列)、下に1セル移動した箇所のセルに、?の文字列を貼り付けたいのです。そのような処理が出来るマクロ等お教えいただけないでしょうか。

※”最初の該当データ”とは、今回の例でいいますと、

1|あいうえおのこと
4|かきくけこの発声練習
6|さしすせそです

になります。

●質問者: moon-fondu
●カテゴリ:コンピュータ 学習・教育
○ 状態 :終了
└ 回答数 : 1/1件

▽最新の回答へ

1 ● a-kuma3
●1500ポイント ベストアンサー

以下のコードをブックA の標準モジュールに貼り付けて、サブルーチンの先頭の変数 ref_book_filename にブックB のファイル名をフルパスで設定してください。
そして、set_data サブルーチンを実行してください。

Sub set_data()
 ref_book_filename = "d:\foo\bar.xlsx"  ' 参照先の Book (フルパス)
 ref_column = 11  ' K列
 search_column = 26  ' Z列
 write_column = search_column + 13  ' AM列

 Set this_book = ActiveWorkbook
 Set ref_book = Workbooks.Open(ref_book_filename)
 this_book.Activate

  ' 別シートの値を読み込む
 Set ref_sheet = ref_book.Sheets(1)  ' ひとつめのシート
 last_row = ref_sheet.Cells(Rows.Count, ref_column).End(xlUp).Row

 Set Map = CreateObject("Scripting.Dictionary")
 For r = 1 To last_row
 Set cell = ref_sheet.Cells(r, ref_column)
 If Not IsEmpty(cell) And Not cell.Value = "" Then
 Map.Add cell.Value, cell.Value
 End If
 DoEvents
 Next

 ref_book.Close
 Set ref_book = Nothing

  ' 対象シートから探して、値を書き込む
 last_row = Cells(Rows.Count, search_column).End(xlUp).Row
 For Each Key In Map.keys
 Debug.Print Key
 For r = 1 To last_row
 If InStr(Cells(r, search_column).Value, Key) > 0 Then
 Cells(r + 1, write_column).Value = Key
 Exit For
 End If
 DoEvents
 Next
 Next

 Set Map = Nothing

End Sub

ブックB のどのシートにデータが入っているかが書いてなかったので、最初のシートから K列の値を読み込むようにしています。

以下のことを前提としています。

二番目の前提は、こういうことです。

1|あいうえおのこと
2|あいうえおについて あいうえお
3|あいうえおです
4|かきくけこの発声練習
5|かきくけこについて かきくけこ
6|さしすせそです
7|さしすせその勉強 さしすせそ
8|さしすせそのアクセント
9|さしすせそについて
 ...
100|また、あいうえお ※ここには、「あいうえお」は書かれない

moon-fonduさんのコメント
ご回答いただきまして、ありがとうございます! ブックBのファイル名を「bar.xlsx」に変えまして、パスが合うように"d:\foo\bar.xlsx"の箇所も書き換えて実行してみました。 すると・・・ -------------------- 実行時エラー"457" このキーは既にこのコレクションの要素に割り当てられています。 -------------------- というエラーらしきウインドウが出てきまして。 「デバッグ」をクリックしてみますと、 「Map.Add cell.Value, cell.Value」の部分が黄色いマーカーのような色で塗られておりました。 a-kuma3さんの前提条件に合ったデータのはずなのですが・・・。 お手数お掛け致しますが、再度、対処法をお教えいただけないでしょうか。 よろしくお願い致します。

a-kuma3さんのコメント
>> 実行時エラー"457" このキーは既にこのコレクションの要素に割り当てられています。 << それは、ブックB の K列に重複したデータがあります。 値を入れているデータに重複がないのが確実であれば、空白に見えて全角の空白が入ってたり、とかないでしょうか。 重複していた場合に無視するようにもできます。 >|vb| Set Map = CreateObject("Scripting.Dictionary") For r = 1 To last_row Set cell = ref_sheet.Cells(r, ref_column) If Not IsEmpty(cell) And Not cell.Value = "" Then If Not map.Exists(cell.Value) Then ' ここを追加 Map.Add cell.Value, cell.Value End If ' ここを追加 End If DoEvents Next ||< 意図していない重複かもしれないので、一応 データの確認もしてみてください。

moon-fonduさんのコメント
重複ありました…ですが、a-kuma3さんの重複無視の方のコードで稼働させてみると、うまく貼り付けができました!ありがとうございました(^^;)
関連質問

●質問をもっと探す●



0.人力検索はてなトップ
8.このページを友達に紹介
9.このページの先頭へ
対応機種一覧
お問い合わせ
ヘルプ/お知らせ
ログイン
無料ユーザー登録
はてなトップ