VBA 2表の差分抽出 1:2で出現するケースも差分として抽出したい

前提

「データ①」シート「データ②」シート「差分」シートがあり、
データ①にあってデータ②にないものを差分シートに書き出すプログラムがあるのですがもう一声カスタムしたいとおもっています

イメージ説明
イメージ説明
イメージ説明

イメージ説明

実現したいこと

  • データ①には「6/4 田中 ボールペン 400」というのが2つあります。データ②には一つしかない、でも以下のプログラムではデータ②に一行でもあれば差分として抽出しません。1:1で現れるケースは差分ではないけれどこの場合でいうと一行だけ「6/4 田中 ボールペン 400」を差分として抽出したいのです

該当のソースコード

Public Sub MainProc() Dim shtMain As Worksheet Dim motoName As String Dim sakiName As String Dim shtMoto As Worksheet Dim shtSaki As Worksheet Dim shtSabun As Worksheet Dim lastRowMoto As Long Dim lastRowSaki As Long Dim lastCol As Long Dim i As Long Dim j As Long Dim k As Long Dim blnSame As Boolean Dim blnExist As Boolean Dim nowRow As Long '①「メイン」シートを変数に格納する Set shtMain = ThisWorkbook.Sheets("メイン") '②比較元シート名を変数に格納する motoName = shtMain.Range("A2") '③比較先シート名を変数に格納する sakiName = shtMain.Range("B2") '④比較元シートを変数に格納する Set shtMoto = ThisWorkbook.Sheets(motoName) '⑤比較先シートを変数に格納する Set shtSaki = ThisWorkbook.Sheets(sakiName) '⑥差分シートを変数に格納する Set shtSabun = ThisWorkbook.Sheets("差分") '⑦比較元シートの最終行を取得する lastRowMoto = shtMoto.Cells(shtMoto.Rows.Count, 1).End(xlUp).Row '⑧比較元シートの最終列を取得する lastCol = shtMoto.Cells(1, shtMoto.Columns.Count).End(xlToLeft).Column '⑨比較先シートの最終行を取得する lastRowSaki = shtSaki.Cells(shtSaki.Rows.Count, 1).End(xlUp).Row '⑩差分シートをクリアする shtSabun.Cells.Clear '⑪比較元シートのヘッダー行を差分シートにコピーする shtMoto.Range(shtMoto.Cells(1, 1), shtMoto.Cells(1, lastCol)).Copy (shtSabun.Cells(1, 1)) nowRow = 1 '⑫比較元シートと比較先シートを比較し、差分行を差分シートにコピーする For i = 2 To lastRowMoto blnExist = False For j = 2 To lastRowSaki blnSame = True For k = 1 To lastCol If shtMoto.Cells(i, k) <> shtSaki.Cells(j, k) Then blnSame = False Exit For End If Next If blnSame = True Then blnExist = True Exit For End If Next If blnExist = False Then nowRow = nowRow + 1 shtMoto.Range(shtMoto.Cells(i, 1), shtMoto.Cells(i, lastCol)).Copy (shtSabun.Cells(nowRow, 1)) End If Next MsgBox "完了" End Sub

考えたこと

If blnSame = True Then
が同じものがあった場合なにもしない…なのでのでここになにか条件を入れればいいような気がしているのですが見つかりません

もしくは別の発想でまったく別にプログラムをつくり同一のものを一行づつ削除し残ったものを抽出、という形でもいいのですがなにかいいアイデアOR方法ありますでしょうか…
ご教授願えましたら幸いです。

コメントを投稿

0 コメント