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

Excel VBA のコードを書いていただけませんか。

シート1の列Aに、3文字のアルファベットが入っています。
シート2の列Aにも、同じく3文字のアルファベットが入っています。
このシート2の列Aの3文字と同じ文字を、上記シート1の列Aに探し出し、
シート2の列A?Yを、該当する3文字が存在する行の、シートAの列B?Zに移動させたいです。
ただし、シート1の列Aに、シート2の列Aにあるすべての組み合わせの3文字があるとは限りません。
なので、シート2にはあるが、シート1には無い場合は、その行は移動させずに、残しておいてください。

全体をデータベースチックに言い直すと、
【図】のように、列Aを「キー・フィールド」として、
シート1に、シート2をマージさせてください(ただしシート1に該当のキー文字列が無い場合は、消さずに残す)。

どうぞよろしくお願いいたします。

1297542855
●拡大する

●質問者: Excel-VBA
●カテゴリ:コンピュータ 学習・教育
✍キーワード:Excel VBA アルファベット キー コード
○ 状態 :終了
└ 回答数 : 2/2件

▽最新の回答へ

1 ● SALINGER
●70ポイント

たぶん、VBAで移動させてから、後は列を自分で調整するということで図と違うかなと思うので、

とりあえず質問通りの動作のマクロです。

シート名を変更する場合はコード最初の方の該当箇所を変更してください。


Sub Macro()
 Dim ws1 As Worksheet
 Dim ws2 As Worksheet
 Dim i As Long
 Dim lastRow As Long
 Dim stRow As Long
 Dim res As Object
 
  'シート名を設定
 Set ws1 = Worksheets("シート1")
 Set ws2 = Worksheets("シート2")
 
  'シート2の最初の行
 stRow = 2
 
  'シート2の最終行の取得
 lastRow = ws2.Cells(Rows.Count, "A").End(xlUp).Row
 
  '削除するので下の行から走査
 For i = lastRow To stRow Step -1
 If Cells(i, "A").Value <> "" Then
  'シート1を検索
 Set res = ws1.Range("A:A").Find(what:=ws2.Cells(i, "A").Value, LookIn:=xlValues, lookat:=xlWhole)
 If Not res Is Nothing Then
 ws2.Activate
  'コピー
 ws2.Range(Cells(i, "A"), Cells(i, "Y")).Copy res.Offset(0, 1)
 
  '一致したシート2の行を削除してシート2を詰める
 ws2.Rows(i).Delete
  '詰めない場合
  'ws2.Rows(i).Clear
 End If
 End If
 Next i
End Sub
◎質問者からの返答

ありがとうございます!


2 ● online_p
●0ポイント

sed

関連質問


●質問をもっと探す●



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