1325646546 エクセル2003

画像を参照下さい。
1.シートA、シートBがあります
2.ナンバーを軸(同一のナンバーは存在しません)に
 シートAに在ってシートBにないものはシートCには載せない
3.シートBに在ってAにないものはCに載せる
4.AとB両方にある場合はBの情報をCに載せる

これをマクロで、ボタンをポチと押せばサッサッサーとできるよう
お願いいたします。質問などはコメント欄にお書きください。

回答の条件
  • 1人2回まで
  • 13歳以上
  • 登録:2012/01/04 12:04:47
  • 終了:2012/01/11 12:05:09

ベストアンサー

id:TransFreeBSD No.1

TransFreeBSD回答回数653ベストアンサー獲得回数2622012/01/07 18:30:38

ポイント200pt

Option Explicit

Sub Macro1()
    ' データ対象範囲を指定
    ' 終了行は後で求める
    Const startCol = "A"
    Const indexCol = "G"
    Const endCol = "AU"
    Const startRow = 4
    Dim endRowA As Long
    Dim endRowB As Long
    Dim nowRowC As Long
    Dim indexA As Range
    Dim indexB As Range
    Dim sheetA As Worksheet
    Dim sheetB As Worksheet
    Dim sheetC As Worksheet
    Dim i As Long
    Dim res As Object
    ' それぞれのシートを指定
    Set sheetA = Worksheets("SheetA")
    Set sheetB = Worksheets("SheetB")
    Set sheetC = Worksheets("SheetC")
    ' シートAとシートBの最終行を求める
    endRowA = sheetA.Cells(sheetA.Rows.Count, indexCol).End(xlUp).Row
    endRowB = sheetB.Cells(sheetB.Rows.Count, indexCol).End(xlUp).Row
    ' シートCのデータの追加行
    nowRowC = startRow
    ' シートAとシートBのインデックスとなるナンバーの範囲
    Set indexA = sheetA.Range(sheetA.Cells(startRow, indexCol), sheetA.Cells(endRowA, indexCol))
    Set indexB = sheetB.Range(sheetB.Cells(startRow, indexCol), sheetB.Cells(endRowB, indexCol))
    
    ' まずシートAの上から順に見ていく
    For i = startRow To endRowA
        ' シートBから同じナンバーを探す
        Set res = indexB.Find(what:=sheetA.Cells(i, indexCol).Value, _
            LookIn:=xlValues, lookat:=xlWhole, MatchCase:=True, Matchbyte:=True)
        ' 見つかったらシートCにコピーする
        If Not res Is Nothing Then
            sheetB.Range(sheetB.Cells(res.Row, startCol), sheetB.Cells(res.Row, endCol)) _
                .Copy Destination:=sheetC.Cells(nowRowC, startCol)
            nowRowC = nowRowC + 1
        End If
    Next i
    ' 次にシートBの上から順に見ていく
    For i = startRow To endRowB
        ' シートAから同じナンバーを探す
        Set res = indexA.Find(what:=sheetB.Cells(i, indexCol).Value, _
            LookIn:=xlValues, lookat:=xlWhole, MatchCase:=True, Matchbyte:=True)
        ' 見つからなかったらシートCにコピーする
        If res Is Nothing Then
            sheetB.Range(sheetB.Cells(i, startCol), sheetB.Cells(i, endCol)) _
                .Copy Destination:=sheetC.Cells(nowRowC, startCol)
            nowRowC = nowRowC + 1
        End If
    Next i
End Sub

こんなところでいかがでしょうか。

id:namaewa_5

回答ありがとうございます。
水曜日に検証してみます!

2012/01/07 19:02:34
id:namaewa_5

回答ありがとうございました。
まだ試せていませんが追加・修正がありましたら
IDコールさせていただきますのでその際はよろしくお願い致します。(もちろんポイントはお支払いしますので)

リニューアルしてから本当、回答がつかなくなりました。。。
しかも埋もれていく速さが半端ないです・・・あぁーぁー

2012/01/11 20:55:06
  • id:taknt
    回答できないけど、こんな簡単なの 誰か サッサッサーと作ってくれるだろうね。
  • id:TransFreeBSD
    >>
    1.シートA、シートBがあります
    <<
    この時、シートCはどうなってるのでしょうか?
    シートCもあって、シートCにしか無いデータは残すと言う考えで間違いないですか?
  • id:cno
    2.3.4の条件を満たすと結果的にBの内容をCに書き足すような処理になると思いますが、
    意図されている条件という認識でよいでしょうか?
  • id:namaewa_5
    >TransFreeBSD

    この時、シートCはどうなってるのでしょうか?
    シートC項目(タイトル)のみ表示されていると思っていただいて結構です



    >cno
    意図されている条件という認識でよいでしょうか?

    はい、その条件でお願いします
  • id:TransFreeBSD
    シートCにデータがないのなら、シートBをまるまるコピーすれば済むと思うのですが、それで間違いないのでしょうか?
    一番簡単なのはシートCを消し、シートBを複製してシートCにすることだと思う。
  • id:namaewa_5
    説明が一つ足りなかったですね
    大元のデータがシートAに入力されています。
    シートBは番号がランダムな状態で落とされてシートBに張り付けられています。
    シートAの順番通りに並んだ状態でシートAとシートBのマッチングを行い
    シートAの順番通りにシートCにデータを反映させる。ということがやりたいのです。


    1.シートAにある番号順に並ぶ
    2.シートAになくてシートBにある番号、つまり新たな番号は
     シートAの番号の最後に追加される並び順でシートCに反映される
    3.シートAにありシートBにない番号、つまり削除される番号は
     シートAの番号順から削除(行削除)されシートCに反映される

    あーやっぱり新しいはてなになってから回答がつかないなー
    規約違反として通知
  • id:TransFreeBSD
    締め切りましたか。ようやく納得のいく仕様になったと思うのですが。
  • id:namaewa_5
    受付再開しました!よろしくお願いします
  • id:taknt
    >あーやっぱり新しいはてなになってから回答がつかないなー

    回答拒否になっていて 回答できないだけかと思う。

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

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

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

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