![](http://oshiete.xgoo.jp/images/v2/pc/qa/question_title.png?a65a0e2)
VBAで照合作業用マクロを作成しております。
初心者なのでネット検索などして作成しているのですが
重複データ同士の照合というものが見つからないため
どなたかご教示いただけると助かります。
(OS-Windows7,Office2013)
作業内容:
①シート1とシート2のデータを売上番号と金額をキーにして照合する
②データが一致したシート2の該当行(同行横)へ、シート1の該当行を転記
・シート1,2の売上番号と金額は重複を含む
・重複している売上番号等は、シート1,2で同数
・データは各シート1,000行~1,200行
・マッチング出来ないデータについては空白とする
=======================================
◆質問◆
重複データの"Item"を転記する方法
(転記は金額を基準とする)
=======================================
○シート1(明細データ)
売上番号 金額 Item1 Item2
--------------------------------------
44-3 2,000 500 1,500
11-1 1,000 300 700
11-1 1,000 500 500
11-1 1,500 500 1,000
22-4 3,000 2,000 1,000
○シート2(売上データ)
売上番号 金額 氏名
------------------------
11-1 1,000 佐藤
11-1 1,000 佐藤
11-1 1,500 佐藤
55-2 4,500 上田
22-4 3,000 松本
↓マクロを実行
○シート2 完成表(希望)
売上番号 金額 氏名 Item1 Item2
------------------------------------------------
11-1 1,000 佐藤 300 700
11-1 1,500 佐藤 500 500
11-1 1,000 佐藤 500 1,000
55-2 4,500 上田 (空白)
22-4 3,000 松本 2,000 1,000
==========================================
下記マクロを実行した結果:
重複番号の"Item"列が1行しか転記されない->重複最終行のみ
(ユニークの番号同士については問題なく転記される)
=============================================
Sub TEST01()
Dim sht1, sht2
Application.ScreenUpdating = False
Set sht1 = Worksheets("Sheet1")
Set sht2 = Worksheets("Sheet2")
d = sht1.Range("A5536").End(xlUp).Row
On Error Resume Next
For i = 2 To d
'条件設定
If sht1.Cells(i, "A") = sht2.Cells(i, "A") Then
ElseIf sht1.Cells(i, "B") = sht2.Cells(i, "B") Then
End If
If sht1.Cells(i, "C") <> sht2.Cells(i, "C") Then
'Sheet2で該当行を検索
For r = 2 To 1000
If sht1.Cells(i, "A") = sht2.Cells(r, "A") Then Exit For
Next r
'該当行をSheet2へ転記
sht2.Cells(r, "D") = sht1.Cells(i, "C")
sht2.Cells(r, "E") = sht1.Cells(i, "D")
End If
Next i
Application.ScreenUpdating = True
End Sub
どうぞよろしくお願いします。
No.1ベストアンサー
- 回答日時:
こんにちは。
んー、なんていうか、そういう処理をする場合は、
何でもかんでもVBAの力技に任せるのではなくて、
ある程度、扱い易いシートデザインを用意しておくのが本筋とは思います。
例えば、実質的な主キーは、
A列とB列を連結(実戦では区切り文字を挟みます)したもの、なのですから、
予め、実質的な主キーをひとつのフィールドとして用意しておくとか、
それだけでもVBAの処理は易しくなり、
VBA側の設計も幅が出てきて易しくなります。
VBAだけでなくて全体の設計を見直した方がベターではあります。
色々事情はおありでしょうから、このことは先の話として、置いといて、
本題に直接的にお答えします。
要は、
同じ(ユニークでない)キーに対して、
複数のデータがあり、それらを、順番にピックアップして、
ひとつの表にまとめたい、ということだと理解しています。
これはこれで、'表計算'や'データベース'のアプリケーションにとっては、
例外的で苦手とする処理のひとつだったりして、
VBA書くのも簡単ではないと思います。
とりあえず、
★Dictionaryオブジェクト
★Collectionオブジェクト
★二次元配列
等、普通は初級では扱わないような手法で、
スクリプトを書くのが(私にとって)簡単な方法で一案、書いてみました。
実質的な主キーの扱いについては、
.Cells(i, "A").Text & vbCr & .Cells(i, "B")
のように、セルには入力できない改行文字を区切り文字を使って、
A列とB列を連結しています。
実質的な主キーに対応したデータを
Dictionaryオブジェクトのアイテムに置いたCollectionオブジェクトに
追加したり削除したりして、
同じ(ユニークでない)キーに対応した複数のデータを順番に出力します。
技術的な解説は一度では難しいので省きますが、
★マークを付けたキーワードについて、調べてみて、
その上でお尋ねになりたいことがあれば、ひとつひとつお応えします。
何をどうやっても難しい要求を実現するのは、難しい、
これは仕方ないことですが、少しでもマシ(技術的により簡単)な
やり方を思いついたら、もしかしてまた回答するかもしれません。
' ' ===============================
Sub Re8929559()
Dim objDict As Object ' As Scripting.Dictionary '
Dim sTemp As String
Dim d As Long
Dim i As Long
Set objDict = CreateObject("Scripting.Dictionary") ' = New Scripting.Dictionary
With Worksheets("Sheet1")
d = .Cells(Rows.Count, "A").End(xlUp).Row
For i = 2 To d
sTemp = .Cells(i, "A").Text & vbCr & .Cells(i, "B")
If VarType(objDict(sTemp)) = vbEmpty Then
Set objDict(sTemp) = New Collection
End If
objDict(sTemp).Add .Range(.Cells(i, "C"), .Cells(i, "D")).Value, CStr(objDict(sTemp).Count)
Next i
End With
Application.ScreenUpdating = False
With Worksheets("Sheet2")
d = .Cells(Rows.Count, "A").End(xlUp).Row
For i = 2 To d
sTemp = .Cells(i, "A").Text & vbCr & .Cells(i, "B")
If objDict.Exists(sTemp) Then
.Range(.Cells(i, "D"), .Cells(i, "E")).Value = objDict(sTemp)(1)
objDict(sTemp).Remove 1
End If
Next i
End With
Application.ScreenUpdating = True
End Sub
' ' ===============================
丁寧なアドバイス参考になります。希望通りの表になりました。
オブジェクトと配列について調べてみましたが、基礎知識が不足しているので不明な点自体が分からないという状態です。基礎的なことをもっと学習する必要を感じています。セルの結合は全く思い浮かびませんでしたので目からウロコでした。質問して良かったです。ありがとうございました。
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Visual Basic(VBA) VBA Userformで一部別シートに転記がしたいのですが 2 2023/05/24 13:08
- Visual Basic(VBA) VBAで最新のデータを別シートに転記する方法をお教えください。 3 2022/04/07 19:20
- Visual Basic(VBA) vba 重複データ合算 5 2023/07/05 18:55
- Visual Basic(VBA) ユーザーフォーム「frm_基本❶」を立ち上げると新規で入力する行数を右下のNoとして表示しています。 1 2023/03/16 19:02
- Excel(エクセル) なぜExit Subがあるのかわかりません 4 2023/02/19 12:34
- Visual Basic(VBA) 複数シートの複数列に入力されているデータを重複なしで抽出するVBAを作りたいです。 9 2022/06/17 10:33
- Visual Basic(VBA) VBAで質問ですが、皆さんはどの様に導き出しているのでしょうか? 6 2022/05/03 21:53
- Visual Basic(VBA) 列と行の名前(重複あり)が交差するセルに、データを入力したい 2 2022/06/25 22:42
- Visual Basic(VBA) いつもお世話になっております、VBAで教えて頂きたいのですが 2 2022/05/05 22:20
- その他(Microsoft Office) マクロVBAについて 1 2022/09/06 18:12
関連するカテゴリからQ&Aを探す
おすすめ情報
- ・漫画をレンタルでお得に読める!
- ・一番好きなみそ汁の具材は?
- ・泣きながら食べたご飯の思い出
- ・「これはヤバかったな」という遅刻エピソード
- ・初めて自分の家と他人の家が違う、と意識した時
- ・いちばん失敗した人決定戦
- ・思い出すきっかけは 音楽?におい?景色?
- ・あなたなりのストレス発散方法を教えてください!
- ・もし10億円当たったら何に使いますか?
- ・何回やってもうまくいかないことは?
- ・今年はじめたいことは?
- ・あなたの人生で一番ピンチに陥った瞬間は?
- ・初めて見た映画を教えてください!
- ・今の日本に期待することはなんですか?
- ・集中するためにやっていること
- ・テレビやラジオに出たことがある人、いますか?
- ・【お題】斜め上を行くスキー場にありがちなこと
- ・人生でいちばんスベッた瞬間
- ・コーピングについて教えてください
- ・あなたの「プチ贅沢」はなんですか?
- ・コンビニでおにぎりを買うときのスタメンはどの具?
- ・おすすめの美術館・博物館、教えてください!
- ・【お題】大変な警告
- ・洋服何着持ってますか?
- ・みんなの【マイ・ベスト積読2024】を教えてください。
- ・「これいらなくない?」という慣習、教えてください
- ・今から楽しみな予定はありますか?
- ・AIツールの活用方法を教えて
- ・最強の防寒、あったか術を教えてください!
- ・歳とったな〜〜と思ったことは?
- ・モテ期を経験した方いらっしゃいますか?
- ・好きな人を振り向かせるためにしたこと
- ・スマホに会話を聞かれているな!?と思ったことありますか?
- ・それもChatGPT!?と驚いた使用方法を教えてください
- ・見学に行くとしたら【天国】と【地獄】どっち?
- ・これまでで一番「情けなかったとき」はいつですか?
- ・この人頭いいなと思ったエピソード
- ・あなたの「必」の書き順を教えてください
- ・14歳の自分に衝撃の事実を告げてください
- ・人生最悪の忘れ物
- ・あなたの習慣について教えてください!!
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
マクロの「SaveAs」でエラーが...
-
マクロ実行後に別シートの残像...
-
EXCELのSheet番号って変更でき...
-
VBA 空白行に転記する
-
Count Ifのセルの範囲指定に変...
-
【VBA】特定の条件でセルをコピー
-
Changeイベントで複数セルへの...
-
100万件越えCSVから条件を満た...
-
ExcelVBAで、オートフィルタに...
-
Excel VBA オートフィルターで...
-
ExcelのVBマクロを、バックグラ...
-
VBA別シートの最終行の次行へ転...
-
Excel2013で切り取り禁止
-
VBA シリアル値から月日への変換
-
VBAで変数の数/変数名を動的に...
-
VBA 重複チェック後に値をワー...
-
【VBA】データを各シートに自動...
-
日々の注文集計表のシートを比...
-
ExcelのVBAでやりたい操作でで...
-
VBA 実行時エラー1004 rangeメ...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
マクロの「SaveAs」でエラーが...
-
EXCELのSheet番号って変更でき...
-
VBA 空白行に転記する
-
マクロ実行後に別シートの残像...
-
Count Ifのセルの範囲指定に変...
-
楽天RSSからエクセルVBAを使用...
-
VBA別シートの最終行の次行へ転...
-
Changeイベントで複数セルへの...
-
【VBA】特定の条件でセルをコピー
-
100万件越えCSVから条件を満た...
-
VBAで変数の数/変数名を動的に...
-
VBA 実行時エラー1004 rangeメ...
-
VBAでEXCELから固定長...
-
Excel2013で切り取り禁止
-
Excel VBA オートフィルターで...
-
VBA 別ブックからの転記の高速...
-
Unionでの他のシートの参照につ...
-
ExcelのVBマクロを、バックグラ...
-
アクセスからエクセルへ出力時...
-
テキストボックスから、複数の...
おすすめ情報