1297542855 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に該当のキー文字列が無い場合は、消さずに残す)。

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

回答の条件
  • 1人2回まで
  • 13歳以上
  • 登録:2011/02/13 05:34:15
  • 終了:2011/02/20 05:35:02

回答(2件)

id:SALINGER No.1

SALINGER回答回数3454ベストアンサー獲得回数9692011/02/13 10:55:25

ポイント70pt

たぶん、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
id:Excel-VBA

ありがとうございます!

2011/02/14 17:26:23

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

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

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

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