• ベストアンサー

2つの表を統合するVBAマクロについて(2)

「2つの表を統合するVBAマクロについて」での質問を補足いたしますのでどうかお力をお貸しください。 前回の質問で例にあげたsheet1の表とsheet2の表を統合してsheet3に統合表を作りたいのですが、どのように統合したいのかといいますと、 (1)それぞれの表のA列をキーに、sheet1にもsheet2にもあるデータは新たに統合する表に採用します。前回の例でいうと、sony1,2,5,7ですね。この両者共通のものは新たに統合する表には、sheet2の方のデータを採用します。(複数ある場合は全て採用します。) (2)次にsheet1にしかないデータは統合する表に採用します。前回の例ではsony003が該当します。 (3)最後にsheet2の方にしかないデータは統合する表には採用しません。無視します。 この(1)から(3)を実行して下記のようは統合表を作成したいのです。 (sheet3 統合表)   A   B   C    D sony001 男  東京 Japan ←(sheet2のデータ) sony002 女  埼玉 Japan ←(sheet2のデータ) sony002 女  千葉 U S A ←(sheet2のデータ) sony003 女  千葉 U S A ←(sheet1のデータ) sony005 女  東京 Russia ←(sheet2のデータ) sony007 男  東京 U S A ←(sheet2のデータ) sony007 女  東京 Russia ←(sheet2のデータ) そしてできれば採用されなかった(無視されたデータ)をsheet4にリストアップしたいのです。 (sheet4 無視されたデータ) sony004 男  大阪 Canada sony006 女  東京 Russia このような処理を自動的にできるVBAマクロがわかる方がいらっしゃいましたら、どうかご教授くださいませ。データが大量なので手動ではとても時間がかかってしまい困っております。どうかお力をお貸しください。よろしくお願いいたします。

質問者が選んだベストアンサー

  • ベストアンサー
  • nishi6
  • ベストアンサー率67% (869/1280)
回答No.1

少し時間があったので作ってみました。 前にあった質問で回答したモジュールをかえてみました。 Sheet1のデータを基準にSheet2のデータを見ています。 うまく動けばいいですが。(標準モジュールに貼り付けます) Public Sub TougouiList() Dim rg1, rg2, rg3, rg4 As Range 'Sheet1~Sheet4の基準とするセル Dim cot1, cot2, cot3, cot4 As Long 'Sheet1~Sheet4のカウンタ ' Const copyCol = 3 'コピーする列数(0から) Dim cl As Integer '列カウンタ ' Set rg1 = Worksheets("Sheet1").Range("A1") Set rg2 = Worksheets("Sheet2").Range("A1") Set rg3 = Worksheets("Sheet3").Range("A1") Set rg4 = Worksheets("Sheet4").Range("A1") Worksheets("Sheet3").UsedRange.Clear Worksheets("Sheet4").UsedRange.Clear ' With rg1 While .Offset(cot1, 0) <> "" Select Case True Case .Offset(cot1, 0) = rg2.Offset(cot2, 0) 'Sheet1とSheet2が一致 While .Offset(cot1, 0) = rg2.Offset(cot2, 0) For cl = 0 To copyCol 'Sheet2のAからD列をコピーする rg3.Offset(cot3, cl) = rg2.Offset(cot2, cl) Next cot2 = cot2 + 1 'Sheet2を更に調べる cot3 = cot3 + 1 Wend cot1 = cot1 + 1 Case rg2.Offset(cot2, 0) <> "" And .Offset(cot1, 0) < rg2.Offset(cot2, 0) 'Sheet1しかない(Sheet2はある) While rg1.Offset(cot1, 0) <> "" And .Offset(cot1, 0) < rg2.Offset(cot2, 0) For cl = 0 To copyCol rg3.Offset(cot3, cl) = .Offset(cot1, cl) Next cot1 = cot1 + 1 'Sheet1を更に調べる cot3 = cot3 + 1 Wend Case rg2.Offset(cot2, 0) = "" 'Sheet1しかない(Sheet2がない) For cl = 0 To copyCol rg3.Offset(cot3, cl) = .Offset(cot1, cl) Next cot1 = cot1 + 1 cot3 = cot3 + 1 Case .Offset(cot1, 0) > rg2.Offset(cot2, 0) 'Sheet2しかない For cl = 0 To copyCol rg4.Offset(cot4, cl) = rg2.Offset(cot2, cl) Next cot4 = cot4 + 1 cot2 = cot2 + 1 End Select Wend 'Sheet2にまだデータがある場合(基準としたSheet1はデータがなくなった) While rg2.Offset(cot2, 0) <> "" For cl = 0 To copyCol rg4.Offset(cot4, cl) = rg2.Offset(cot2, cl) Next cot4 = cot4 + 1 cot2 = cot2 + 1 Wend End With End Sub

kiroro302
質問者

お礼

nishi6さん、早々のご回答どうもありがとうございます。前回も素晴らしいVBAを考えてくださり、また今回もお世話になってしまいまして恐縮しております。前回のnishi6さんのVBAは現在も大活躍で、お陰様で当初の予定の5倍くらいの速さで処理が終了しそうです。今回質問させていただいたことも基本的には前回と同じような処理なのですが、処理する表の仕様が少し変わってしまって、前回のVBAをそのまま実行すると少しエラーが出てしまうところがあり、ご相談させていただきました。私どもはお客様からメールで送られてくる添付ファイル(Excelファイル)に、私どもで行ったあるテスト結果データを書き込んで送り返すので、こちらで表の仕様を変えることは出来ず、このような処理の必要があるのです。テスト結果データは、私どものデータベースから抽出してExcleにExportしていますので、簡単に用意できるのですが、そのデータを、手動で書き込んでいくのは、データの数が大量でとても時間がかかってしまうのです。本日早速1000件くらいの比較的小さな表で実行し、データのズレがないか確認してみましたが、お見事です。データのズレは一つも見つからず、出来上がった統合表も私たちの希望通りのものでした。本当にありがとうございます。nishi6さんのすごさには驚嘆するばかりです。しばらくExcleでの処理が続くと思われますので、また厄介なご質問をすることがあるかもしれません。その際にはどうぞお力をお貸しくださいませ。心よりお願いいたします。そして今回も素晴らしいVBAを作ってくださり本当にありがとうございました。

その他の回答 (3)

  • ranako
  • ベストアンサー率14% (5/34)
回答No.4

もう解決されたようですが、考えてみましたので投稿します。 超簡単な方法で、笑ってしまうかも。(最大件数は変えてください) Sub Macro1() Dim w_cnt1, w_cnt2, w_cnt3, w_cnt4 As Integer Dim w_buff1, w_buff2, w_buff3, w_buff4 As String Dim w_flg As Boolean w_cnt3 = 1 w_cnt4 = 1 For w_cnt2 = 1 To 20 w_buff2 = "A" & w_cnt2 If Sheet2.Range(w_buff2) = "" Then Exit For For w_cnt1 = 1 To 20 w_flg = False w_buff1 = "A" & w_cnt1 If Sheet1.Range(w_buff1) = "" Then Exit For If Sheet1.Range(w_buff1) = Sheet2.Range(w_buff2) Then w_buff2 = "A" & w_cnt2 w_buff3 = "A" & w_cnt3 Sheet3.Range(w_buff3) = Sheet2.Range(w_buff2) w_buff2 = "B" & w_cnt2 w_buff3 = "B" & w_cnt3 Sheet3.Range(w_buff3) = Sheet2.Range(w_buff2) w_buff2 = "C" & w_cnt2 w_buff3 = "C" & w_cnt3 Sheet3.Range(w_buff3) = Sheet2.Range(w_buff2) w_cnt3 = w_cnt3 + 1 w_flg = True Exit For End If Next If w_flg = False Then w_buff2 = "A" & w_cnt2 w_buff4 = "A" & w_cnt4 Sheet4.Range(w_buff4) = Sheet2.Range(w_buff2) w_buff2 = "B" & w_cnt2 w_buff4 = "B" & w_cnt4 Sheet4.Range(w_buff4) = Sheet2.Range(w_buff2) w_buff2 = "C" & w_cnt2 w_buff4 = "C" & w_cnt4 Sheet4.Range(w_buff4) = Sheet2.Range(w_buff2) w_cnt4 = w_cnt + 1 End If Next End Sub

kiroro302
質問者

お礼

ranakoさんご回答ありがとうございます。わざわざ考えていただきとても嬉しく思います。プログラミングにはとても興味を持っておりますので、ranakoさんのVBAを実行してみました。途中でデバックが起動してしまい、残念なことに少しうまくいきませんでしたが、それはきっとranakoさんが最大件数を変えるようにと書かれているようにこちらの表の仕様とプログラムの内容が少し合致しないところがあるのだと思います。今の私の力では自力で修正できず残念です。もう少し勉強をして、こういう場合はここの値を直せばいいんだな、とすぐに修正できるようになりたいと思っております。まだまだ力不足なので、これからもどうぞよろしくお願いいたします。今回はどうもありがとうございました。

  • nishi6
  • ベストアンサー率67% (869/1280)
回答No.3

お礼にお礼・・・ うまくいって良かったですね。 私は、半分くらいは息抜き、もう半分は質問に答えることで新しいことを知ることができるということがありOKWebを楽しんでいます。答えてそれを仕事に応用したこともあります。 april21さんとか私とは違った観点から問題を見ておられるなと感じることも多く、勉強になります。 思われているほど負担でもありませんし、他の回答者もたくさんいらっしゃるのでどんどん質問されてもいいと思います。頑張って下さい。

kiroro302
質問者

お礼

nishi6さん、お礼にお礼なんて恐縮です。私はnishi6さんをはじめ、こういった場で、質問に答えてくださっている方々の行為には心から尊敬いたします。そして、今回のnishi6さんのご回答を読んで、このように謙虚な心持で私たちの質問に答えてくださっているのだということを知り、深く感銘を受けました。nishi6さんたちの回答でどれだけの人が、残業地獄から救われたり、学校の課題でモヤモヤしていたところが吹っ切れたり、新しい道を開拓するきっかけを与えられたりしていることでしょうか!!本当に素晴らしいことだと思います。私もこんな風に人の役に少しでも立つことが出来たら人生2倍も3倍も幸せを感じることができるだろうなぁと羨ましく思います。またnishi6さんのやさしいお言葉に甘えて面倒な質問をしてしまうかもしれませんが、どうぞこれからもよろしくお願いします。本当にありがとうございました。

  • marsah
  • ベストアンサー率42% (3/7)
回答No.2

こんばんわ。 私はVBAは苦手なので、VBA無しで無理やりやる方法を考えてみました。 かえって面倒かもしれませんし、検証していません。(笑) 1. sheet1 と sheet2 においてフィールドAが共通のレコードを選択  クエリのデザインビューでsheet1とsheet2を、フィールドAで結合し、結合のプロパティは“両方のフィールドが同じ行だけを含める”とします。 選択フィールドは、sheet2.[主キーフィールド名] , sheet2.A , sheet2.B , sheet2.C , sheet2.D , ... とします。 このクエリをqueryXとします。 2. sheet1のフィールドAにあって sheet2のフィールドAに無い値を持つレコードを選択  データベースウィンドウでオブジェクトにクエリを選び、新規作成を押して不一致クエリウィザードを選びます。 最初にqueryXを選び、比較するものにsheet1を選びます。 このクエリをqueryYとします。 3. queryXとqueryYをサブセット化する  sheet1とsheet2に同じ値の主キーが含まれている可能性があるときは、どちらかのクエリに細工します。 例えば、元の主キーフィールドを非表示にして、新たなフィールドに“新主キーフィールド名: [主キーフィールド名]+10000”のようにして主キーの代わりとし、sheet1とsheet2に同じ値の主キーが含まれないようにします。 4. queryXとqueryYを連結する  デザインビューでクエリを作成する->テーブルやクエリを追加せず閉じる->SQLビュー とします。 SELECT [queryX].[主キー用フィールド名] , [queryX].[B] , [queryX].[C] , [queryX].[D] , ... FROM [queryX] UNION ALL SELECT [queryY].[主キー用フィールド名] , [queryY].[B] , [queryY].[C] , [queryY].[D] , ... FROM [queryY] と直接入力し、queryZとします。 5. テーブルを作成する  新規クエリでqueryZの全フィールドを選択し、クエリの種類->テーブル作成を選択し、!を押します。 [主キーフィールド名]は該当するフィールド名に置き換えてください。 , ... の意味は、その他の必要なフィールド全てを、ということです。 無視されたデータは、2.の応用->5.で可能です。 お邪魔しました。

kiroro302
質問者

お礼

marsahさん、ご回答ありがとうございます。この処理はACCESSでの処理ですね。私も以前からデータベースを使用して見たいと思っておりましたので大変参考になります。今回の質問での処理は基本的にExcelでのことを想定しておりましたので、時間をとってACCESSでも挑戦してみようと思います。実は処理するデータが大量なので、データの加工をする際にもデータベースを使用した方がいいのか、社内でも案件が出ているところなのです。データに対する処理の使用が複雑になるたびにデータベースソフトの方がいいのかなぁ等と考えてしまいますが、データが大量・処理が複雑=データベースの方がよい、ということでもなさそうなので、安易に転換してしまっていいものかとも思っております。でも今回のmarsahさんのご回答はデータベースに挑戦してみようかな、という気持ちにさせていただきましたので、お力をお借りすることがあるかもしれません。その際にはどうぞよろしくお願いいたします。

関連するQ&A

  • 2つの表を統合するVBAマクロについて

    2つの表を統合したいのですがどなたかお知恵をお貸しください。 (例) sheet1に古い表、sheet2に新しい表があります。それぞれの表はこんな感じです。 (sheet1)   A    B    C    D sony001 男  東京 Japan sony002 女  埼玉 Japan sony003 女  千葉 U S A sony005 男  大阪 Canada sony007 女  東京 Russia (sheet2)   A    B   C   D sony001 男  東京 Japan sony002 女  埼玉 Japan sony002 女  千葉 U S A sony004 男  大阪 Canada sony005 女  東京 Russia sony006 女  東京 Russia sony007 男  東京 U S A sony007 女  東京 Russia これらの表をsheet3にどのように統合したいかといいますと、下記のようは統合表を作成したいのです。 (sheet3 統合表)   A    B    C   D sony001 男  東京 Japan sony002 女  埼玉 Japan sony002 女  千葉 U S A sony003 女  千葉 U S A sony005 女  東京 Russia sony007 男  東京 U S A sony007 女  東京 Russia 質問の長さが800字を超えてしまいますので、この統合表を作成するための手順を「2つの表を統合するVBAマクロについて(2)」で補足したいと思いますのでどうぞよろしくお願いいたします。

  • EXCLEのマクロ 2つのシートを統合する方法

    下記のことを行いたいのです。 教えていただけないでしょうか。 下記2つのシートをA列をキーにして sheet1のあ、b、c列のデータに sheet2のc、d列を 統合して、sheet1のdれつ e列に統合して5列のデータを作りたい a列とb列のデータは基本同じですが、スペースが入っていたり 違う場合もある。B列はsheet1のデータを採用 sheet2は不要 ・sheet1 a列 b列 C列 123 ああ 123456 456 いい 125456 789 うう 12344556 1234 ええ 12345678 4567 おお 123456456 8945 かか 1234567844 ------------------- ・sheet2 a列 B列 C列 D列 123 ああ 03-5212-0000 東京都○ 456 いい 06-5212-0000 大阪府○ 789 うう 044-5212-0000 神奈川県○ 1234 ええ 045-512-0000 横浜市○ 4567 おお 043-212-0000 埼玉県○ 8945 かか 03-5212-0000 東京都○

  • Excelの複数の表を自動的に統合したい

    Excel初心者です。現在「Sheet1」「Sheet2」それぞれに表を作成しています。 これらのデータを自動的に統合して「Sheet3」に新しい表を作成することは可能でしょうか? 「Sheet1」「Sheet2」の表には日々手動でデータを入力しているので、それに伴って「Sheet3」の表も自動的に更新されていくようにしたいのです。 もし方法がありましたらご教授をお願いいたします。

  • エクセルで複数シートからデータを統合したグラフを作る

    エクセル2000を使用しています。 複数のシートの表からデータを統合したグラフを作りたいのです。 たとえば シート1:A 12 B 5 C 7 シート2:A 10 B 5 C 4 というデータから シート3で2つの表を統合したグラフ(たとえば積層グラフ:A  12と10  B・・・)をつくりたい。 但し、表は1つには統合しません。 また、データはそれぞれで、合計ではありません。 データの範囲の指定の仕方がわかりません。(たぶんここでは?) 

  • 表の統合

    エクセルで表を作るときの簡単な方法を探しています。 今、下のようなデータ1とデータ2があります。(ほんとうはたくさんあるのですが、省略させていただきます) そのデータを統合してtotalというデータを作る場合、どのような方法があるでしょうか。 D1   D2 名前 出身 頻度 名前 出身 頻度 山田 東京 3 山田 東京 2 伊藤 埼玉 1 山田 埼玉 1 梅田 大分 2 伊藤 埼玉 2      total 名前 出身  D1 D2 山田 東京 3 2 伊藤 埼玉 1 2 梅田 大分 2 0 山田 埼玉 0 1

  • Excelで統合の機能を使いたい

    Excelで統合の機能を使ってデータを集計したいのです。 例えば、Aさんの売上表をsheet1に作成します。 売上表は、項目やセル位置に若干の違いはあるものの、 似たような作りの表なので、 Aさんのシートを元にして、シートコピーを行い、 コピーしたシートに、Bさんの売上表、Cさんの売上表を作成しました。 そして、集計するためのシートにて、統合を選択しました。 集計方法を「合計」、 統合元範囲をそれぞれ「Aさんのシートにある表範囲」 「Bさんのシートにある表範囲」「Cさんのシートにある表範囲」を追加し、 統合の基準で「上端行」「左端列」にチェックを入れ、OKを押しました。 しかしその結果、合計行が2つでてしまい、正しく集計が行えませんでした。 どこか、やり方が間違っているのでしょうか? 試しに、シートコピーを行わないで各シートごとに表を1から作成し、 統合を実行したところ、ちゃんと合計行も1つで、正しい集計結果が得られました。 もしかして、統合の時には、表をコピーしてはいけないのでしょうか? 以前にも、1から表を作った場合と、シートコピーをした場合とで、 集計結果に、「項目の並び順の違い」がでたことはあったのですが、 そのときは並び順だけが違い、集計結果はあっていたので、 特に気にしていませんでした。 なぜ、こういう結果になってしまうのか、 どなたか、ご存知の方いらっしゃいましたら、 アドバイスいただけたらと思います。 よろしくお願いします。

  • VBAで表を作りたいのだけれど、、

    Excel2007VBAについての質問です。 結構膨大な量のデーターを検証しないといけないので、 お粗末ながらのマクロorVBAを作りたいのですが、 付け焼刃で参考書開いてもよくわからない感じになっています。 やりたいことを簡単に言うと、 Sheet1とSheet2を準備して、Sheet1のA1に値を入れるとB1に計算値が出るようなシートを作りました。 (1)Sheet1のA1B1をコピーして、Sheet2のA1B1にペーストしました。 (2)Sheet1のA1に別の値を入れB1の値も変化しました。 (3)A1B1をコピーして、Sheet2のA2B2にペーストしました。 というようにどんどんコピペで Sheet2に表を作りたいのですがうまくいきません。 どなたか、お力かしてください。。

  • VBA教えてください。(表の作成)

    いつもお世話になっております。 非常に手間となっている作業があり、VBAにしたら楽だろうと思うのですが、自分では作成できずにいます。複雑な内容になるのですが、教えていただける方、お願い致します。 Sheet1に表があり、Sheet2に必要事項のみを抜き出した表を作成したいです。 Sheet1は、横一行が1製品分の情報で、それが、数百行あります。2行目が項目名です。 V列が製品種類、W列が製品名、AV列に番号があります。番号は数字のときも、カナのときもあります。 Sheet2は、V列(製品種類)、W列(製品名)で分類した表になっていて、AV列(番号)を列記したいです。 一枚に印刷したいため、入り組んだ表になります。 この表は、内容が追加されたりと、流動性があるため、それに対応できるようにもしたいと考えています。 今考えていたのは、 Sheet2の右のスペースに、表にするための情報入力するスペースを作り、 Q(通称、Sheet1の表にはない、特に意味はないです)、R(製品種類)、S(製品名)、T(Sheet2の入力箇所を指定) RとSの内容でsheet1のオートフィルタ、 Sheet1のAV列(番号)をコピーして、sheet2のTで指定したところに貼り付ける。 それを上から順に繰り返す。というものです。 ※1 RとS→Sheet1のAV(番号)をT(入力箇所)に格納ですが、T(入力箇所)に入るRとSは1つとは限らず、2、3種類あるものもあります。 ※2 同じT(入力箇所)のなかで、AV(番号)が重複する場合もあり、その際は、1回のみ入力したいです。  →例えば、R(ノート)&S(A社用)(T(N6)に入力)でAVが7000、R(ノート)&S(A社用)(T(N6)に入力)でAVが7000 この場合は7000、7000ではなく、7000にしたいです。 さらに、これを1日数回行います。 Sheet1の情報は、1日の中で下に追加されていき、削除されることも、順番が入れ替わることもありません。1日分の情報をまとめて1枚にしたいです。あとから同じ番号が出てくることもありません。 また、どこから追加されたのかが分かるようにもしたいのです。分かるようにというのは、太い罫線が入ってもいいですし、書体が変わってもいいですし、色が変わってもいいです。 例えば、1回目作成した際に(イ、エ1、ナ、タ1、タ2)のとき、2回目は(イ、エ1、ナ、タ1、タ2//ナ1、ミ、ヤ)というような感じです。3回目があっても追加です。 前回の内容は残す必要はなく、1日のなかで上書きで大丈夫です。日が変わると、Sheet1も一度空になり、その際にSheet2のデータもクリアにしますが、それは自分で作成できそうです。 どうぞよろしくお願い致します。

  • VBAでの差分比較のマクロの組み方について

    VBA初心者です。 シートCの開始ボタンを押下すると、シートAの表とシートBの表のセル内の数式を取得・比較して、シートCの表に差分箇所に色が付く。 ↑のような形で差分比較をするマクロを組みたいのですが、ネットで調べてもうまく作ることができませんでした。 組み方は色々あるかと思いますが、その一例をお教えいただけると幸いです。 よろしくお願いいたします。 (補足) シートAの表とシートBの表の形式は同一で、例えばそれぞれセルの(1,1)〜(150,50)まであるようなイメージです。

  • Excel VBA で表の参照先を一気に変更させるには?

    複数のsheetに規則正しくデータと表が配置されているとします。で以下のようなデータの縦棒の表があるとします。 *データ* A B 1 4 2 2 3 8 4 5 5 1 『グラフ』 - 『元のデータ』で参照先を見ると… =Sheet1!$A$1:$B$6 追加で 例>+5件のデータが加わったとします。 ※一部のsheetだけではなく、全てのsheetで追加です。 *データ追加* 6 3 7 3 8 1 9 8 10 7 グラフの参照先 =Sheet1!$A$1:$B$11 複数のsheetにまたがると、手作業で追加データを追加していて大変手間が食ってしまい困っています。Excel VBA で表の参照先を一気に変更させる方法ありますでしょうか? アドバイスよろしくお願い致します。  

専門家に質問してみよう