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

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

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

1325646546
●拡大する

●質問者: namaewa_5
●カテゴリ:コンピュータ
○ 状態 :終了
└ 回答数 : 1/1件

▽最新の回答へ

1 ● TransFreeBSD
●200ポイント ベストアンサー

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

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


namaewa_5さんのコメント
回答ありがとうございます。 水曜日に検証してみます!

namaewa_5さんのコメント
回答ありがとうございました。 まだ試せていませんが追加・修正がありましたら IDコールさせていただきますのでその際はよろしくお願い致します。(もちろんポイントはお支払いしますので) リニューアルしてから本当、回答がつかなくなりました。。。 しかも埋もれていく速さが半端ないです・・・あぁーぁー
関連質問

●質問をもっと探す●



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