質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

新規登録して質問してみよう
ただいま回答率
86.12%
VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

解決済

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

kumiko
kumiko

総合スコア45

VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

2回答

0リアクション

0クリップ

375閲覧

投稿2022/09/21 07:25

編集2022/09/22 07:01

前提

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

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

イメージ説明

実現したいこと

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

補足

データ②も重複します。
データ①:データ②が、3:1 とか 4:1 になることもあります。
3:2などどちらも複数のケースもあります。
逆もしかりです。

3:1であれば2行抽出、 4:1 であれば3行抽出したいです。
3:2であれば3-2の1行抽出したいです。

実は製品の部品表の新旧リストを比較したいのですがリベットなどアセンブリの子部品として繰り返しでてくるものがいろいろありこのケースで増減あっても見えなくなってしまうため

員数ではなく行で出したいのは「削除すべきこの行が3行ありますよ」とか表現したいためです

エクセル2013です

該当のソースコード

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方法ありますでしょうか…
ご教授願えましたら幸いです。

以下のような質問にはリアクションをつけましょう

  • 質問内容が明確
  • 自分も答えを知りたい
  • 質問者以外のユーザにも役立つ

リアクションが多い質問は、TOPページの「注目」タブのフィードに表示されやすくなります。

気になる質問をクリップする

クリップした質問は、後からいつでもマイページで確認できます。

またクリップした質問に回答があった際、通知やメールを受け取ることができます。

下記のような質問は推奨されていません。

  • 間違っている
  • 質問になっていない投稿
  • スパムや攻撃的な表現を用いた投稿

適切な質問に修正を依頼しましょう。

hatena19

2022/09/21 08:31 編集

確認ですが、 データ①には重複する場合があるのは分かりましたが、データ②には重複はないということでいいですか。 データ①:データ②が、3:1 とか 4:1 になることはありますか。 あるなら、その場合は、差分はどうなりますか。3:1 でも1件建ての表示でいいですか。それとも、3-1の2件表示ですか。 あと、エクセルのバージョンはなんでしょうか。
kumiko

2022/09/22 00:42 編集

データ②も重複します。データ①:データ②が、3:1 とか 4:1 になることもあります。逆もしかり。 3:1であれば2行抽出、 4:1 であれば3行抽出となります。 実は製品の部品表の新旧を比較したいのですがリベットなどアセンブリの子部品として繰り返しでてくるものがいろいろあり増減が見えなくなってしまうのです…。 員数ではなく行で出したいのは削除すべきこの行が3行あるよとか表現できるので エクセル2013です
hatena19

2022/09/22 04:19

3:2の場合はどうなりますか? 3-2の1行抽出でしょうか?
kumiko

2022/09/22 06:56

ご連絡ありがとうございます。そうなります。

まだ回答がついていません

会員登録して回答してみよう

アカウントをお持ちの方は

15分調べてもわからないことは
teratailで質問しよう!

ただいまの回答率
86.12%

質問をまとめることで
思考を整理して素早く解決

テンプレート機能で
簡単に質問をまとめる

質問する

関連した質問

同じタグがついた質問を見る

VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。