[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『2つのシートをマッチングして更新』(大盛りがきつい年ごろ)
はじめまして
シート1
番号|名前|所属
シート2
番号|名前|所属
以上のようなデータが入った二つのシートを、番号をキーにして
名前もしくは所属の違う行を探し、あればシート1のそのデータを
シート2のデータに更新。また、そもそも番号が違うものは弾く(シート3にコピー)
ようなものを作りたいと思っています。
ただ、以下のコードだと、シート1の番号が一つでもシート2にないと
エラーが出てしまうので、これを直した上で番号の異なるシート2のデータを抽出したいです。
(逆は抽出できるのですが)
また、現状は抽出したものをシート2に残し残りをシート3へコピーするようになっているので、これを逆にしたいです。
改善策をご教授いただけないでしょうか?
なにとぞよろしくお願い申し上げます。
Sub 更新()
Dim r As Long Dim c As Range Dim cc As Range
Worksheets("Sheet1").Select
For r = Range("A65536").End(xlUp).Row To 1 Step -1 'シート2のA列を参照 Set c = Worksheets("Sheet2").Range("A:A").Find(what:=Cells(r, "A").Value, LookIn:=xlValues, lookat:=xlWhole)
'シート3コピー用 If cc Is Nothing Then Set cc = c.EntireRow Else Set cc = Union(cc, c.EntireRow) End If
'データの違うものを見つけたら更新 If Not c Is Nothing Then c.Columns("A:J").Copy Cells(r, "A").Offset(1).Insert Set c = Worksheets("Sheet2").Range("A:A").FindNext(c) ' Cells(r, "A").EntireRow.Delete shift:=xlShiftUp Cells(r, "A").Columns("A:J").Delete shift:=xlShiftUp End If
Next r 'シート2A列未参照を残し、残りをシート3へ If Not c Is Nothing Then cc.Copy Sheets("Sheet3").Range("A1").PasteSpecial cc.Delete End If End Sub
< 使用 Excel:Excel2007、使用 OS:Windows7 >
ここまで出来ていればもうすぐじゃないですか? If Not c Is Nothing Then cc.Copy Sheets("Sheet3").Range("A1").PasteSpecial cc.Delete End If この部分の If Not c Is Nothing Then を If Not cc Is Nothing Then に直せばエラー消えませんか?
>また、現状は抽出したものをシート2に残し残りをシート3へコピーするようになっているので、これを逆にしたいです。 逆って言うのはどういう意味で? Sheet2にコピーという意味? それとも全部コピーして消す? (稲葉) 2016/02/19(金) 15:49
見落とし 'シート3コピー用 If cc Is Nothing Then Set cc = c.EntireRow Else Set cc = Union(cc, c.EntireRow) End If ここも、cがNothingだったらエラーになるはずなので、If Not c Is Nothing Thenで分岐されてはどうですか? (稲葉) 2016/02/19(金) 15:51
ありがとうございます
>また、現状は抽出したものをシート2に残し残りをシート3へコピーするようになっているので、これを逆にしたいです。
逆って言うのはどういう意味で?
これは、抽出したデータ(番号の違うデータ)をシート3に移したいのですが、現状は番号のマッチしたデータがシート3にコピーされ、シート2から削除。となっているので、番号の異なるデータをシート3にコピーしたい私の理想と逆という意味です。言葉足らずで申し訳ありません。
また、ご指摘いただいたとおりに2か所修正いたしましたが、エラーが出ます。
cとccで紛らわしくて申し訳ありません。見落としがあるのかと・・・
ご再考のほどお願いできれば幸いです。
(大盛りがきつい年ごろ) 2016/02/19(金) 16:11
シート3に移すってことですが、シート3には既にデータはありますか? 無ければシート2をコピーして、見つけた行を消せば自然と残りますが・・・ (稲葉) 2016/02/19(金) 16:19
稲葉様のご指摘の通り修正して、両方の番号を完全一致させて走らせてみたところ
シート2の一番上のデータのみシート3へコピー&シート2から削除されました。
番号不一致の場合はエラーが出ます。
(大盛りがきつい年ごろ) 2016/02/19(金) 16:23
同じ環境作ってないから何とも言えないけど・・・ こういうことでいいのですか?
Sheet1 |[A]|[B] [1] | 1|あ [2] | 2|あ [3] | 3|あ [4] | 4|あ [5] | 5|あ [6] | 6|あ [7] | 7|あ [8] | 8|あ [9] | 9|あ [10]| 10|あ
Sheet2 |[A]|[B] [1] | 5| [2] | 4| [3] | 3| [4] | 2| [5] | 1| [6] | 9| [7] | 8| [8] |100| [9] | 6| [10]| 10|
実行結果 Sheet3(Sheet2(2)) |[A]|[B] [1] |100| [2] | | [3] | | [4] | | [5] | | [6] | | [7] | | [8] | | [9] | | [10]| |
Sheet2 |[A]|[B] [1] | 5|あ [2] | 4|あ [3] | 3|あ [4] | 2|あ [5] | 1|あ [6] | 9|あ [7] | 8|あ [8] |100| [9] | 6|あ [10]| 10|あ
コード Sub test() Dim r As Range Dim f As Range Dim dr As Range Dim WS2 As Worksheet Dim WS3 As Worksheet Set WS2 = Sheets("Sheet2") WS2.Copy after:=Sheets(Sheets.Count) Set WS3 = Sheets(Sheets.Count) With Sheets("Sheet1") For Each r In .Range("A1", .Cells(Rows.Count, "A").End(xlUp)) Set f = WS2.Range("A:A").Find(What:=r.Value, _ LookIn:=xlValues, _ lookat:=xlWhole) If f Is Nothing Then '見つからなかった時の処理 'なにもしない Else '見つかった時の処理 f.EntireRow.Value = r.EntireRow.Value If dr Is Nothing Then Set dr = WS3.Cells(f.Row, "A").EntireRow Else Set dr = Union(dr, WS3.Cells(f.Row, "A").EntireRow) End If
End If Next r If Not dr Is Nothing Then dr.Delete End If End With MsgBox "処理が完了しました" End Sub (稲葉) 2016/02/19(金) 16:36
Sheet1
|[A]|[B] [1] | 1|あ [2] | 2|あ [3] | 3|あ [4] | 4|あ [5] | 5|あ [6] | 6|あ [7] | 7|あ [8] | 8|あ [9] | 9|あ [10]| 10|あ
Sheet2 |[A]|[B] [11]| 5| [2] | 4| [3] | 3| [4] | 2| [5] | 1| [6] | 9| [7] | 8| [8] |100| [9] | 6| [10]| 10|
実行結果
Sheet1
|[A]|[B] [1] | 1|あ [2] | 4|あ [3] | 3|あ [4] | 2|あ [5] | 1|あ [6] | 9|あ [7] | 8|あ [8] |100|あ [9] | 6|あ [10]| 10|あ
Sheet2
|[A]|[B] [2] | 4| [3] | 3| [4] | 2| [5] | 1| [6] | 9| [7] | 8| [8] |100| [9] | 6| [10]| 10|
Sheet3 |[A]|[B] [11]| 5 |あ
このようにしたいです
(大盛りがきつい年ごろ) 2016/02/19(金) 17:01
実行結果のシート3は
|[A]|[B]
[11]| 5
です
(大盛りがきつい年ごろ) 2016/02/19(金) 17:04
仕様勘違いしていましたね。 Sheet1にSheet2のデータを入れるのですね? そうすると、Sheet2で総当たりしたほうがいいと思いますが、 Sheet1の総当たりでいいのですか?
>f.EntireRow.Value = r.EntireRow.Value ここの部分 r.EntireRow.Value = f.EntireRow.Value
これで仕様通りになりませんか? これ以降来週になります。 (稲葉) 2016/02/19(金) 17:57
r.Columns("A:J").Value = f.Columns("A:J").Value
If dr Is Nothing Then
Set dr = WS3.Cells(f.Row, "A").EntireRow Else Set dr = Union(dr, WS3.Cells(f.Row, "A").EntireRow) End If
以上のように修正して、解決いたしました。
稲葉様、ありがとうございました。
(大盛りがきつい年ごろ) 2016/02/19(金) 18:29
改めて質問させていただきます
Sheet1
|[A]|[B]|[C]|[D] [1] | ○|× | 1 |あ [2] | ○|× | 2 |あ [3] | ○|× | 3 |あ [4] | ○|× | 4 |あ [5] | ○|× | 5 |あ
Sheet2 |[A]|[B] [1] | 11| [2] | 2|い [3] | 13| [4] | 14| [5] | 15|
上記のように、マッチングさせたい列が違う時
(例だとSheet1のC列とSheet2のA列)
思うようにコピーできません。
列に空欄ができたり、D列以降のデータがコピーされなかったりします。
(更新しないデータがD列以降にあります)
Sub 更新()
Dim r As Range Dim f As Range Dim dr As Range Dim WS1 As Worksheet Dim WS2 As Worksheet Dim WS3 As Worksheet Set WS1 = Sheets("Sheet1") Set WS2 = Sheets("Sheet2") WS2.Copy after:=Sheets(Sheets.Count) Set WS3 = Sheets(Sheets.Count) With Sheets("Sheet1") For Each r In .Range("D2", .Cells(Rows.Count, "D").End(xlUp))
'ここをSheet2のF列を参照してマッチングに変更 Set f = WS2.Range("F:F").Find(What:=r.Value, _ LookIn:=xlValues, _ lookat:=xlWhole) If f Is Nothing Then '見つからなかった時の処理 'なにもしない Else '見つかった時の処理 ' r.EntireRow.Value = f.EntireRow.Value
'Sheet1のD列からJ列をSheet2のA列からHまでのものに更新 r.Columns("D:J").Value = f.Columns("A:H").Value
'空欄が出るので削除しようと試みているが意味なし?////// If Len(Cells(f.Row, "M").Value) = 0 Then WS1.Cells(r.Row, "M").Delete xlShiftToLeft End If If Len(Cells(f.Row, "L").Value) = 0 Then WS1.Cells(r.Row, "L").Delete xlShiftToLeft End If If Len(Cells(f.Row, "K").Value) = 0 Then WS1.Cells(r.Row, "K").Delete xlShiftToLeft End If '///////////////////////////////////////////////
'このA列指定は If dr Is Nothing Then Set dr = WS3.Cells(f.Row, "A").EntireRow Else Set dr = Union(dr, WS3.Cells(f.Row, "A").EntireRow) End If
End If Next r If Not dr Is Nothing Then dr.Delete End If End With End Sub
今一度ご教授願えないでしょうか
(大盛りがきつい年ごろ) 2016/02/26(金) 13:29
Seet1はD列を参照します
(大盛りがきつい年ごろ) 2016/02/26(金) 13:33
二度手間は面倒なので、再現出来るように説明してください。 現状では、Sheet2のF列になにが入力されているのかわかりません。
レイアウトは [[20110209184943]] 『[談]シートレイアウトの投稿どうしてますか?』(momo) こちらのユーティリティを使うと便利です。
(稲葉) 2016/02/26(金) 14:39
|[A] |[B] |[C] |[D] |[E] |[F] |[G] |[H]|[I]|[J]|[K]|[L] |[M] [1]|記録日(年)|記録日(月)|記録日(日)|キー番号 |氏名|フリガナ|性別|生 |年 |月 |日 |学校名|所属 [2]| 28| 10| 1| 101|××|△ |女 |平 | 10| 2| 11|● |● [3]| 28| 2| 19| 12345|××|△ |男 |昭 | 55| 7| 25|● |● [4]| 28| 2| 19| 1234500|××|△ |男 |昭 | 31| 12| 12|● |● [5]| 28| 2| 19| 56321|××|△ |男 |昭 | 56| 9| 24|● |●
Sheet2
|[A] |[B] |[C] |[D] |[E] |[F] |[G] |[H] [1]|ID番号|氏名|フリガナ|生年月日|性別|キー番号 | コード|所属 [2]| |× |△ |2016/1/2|女 | 101| |● [3]| |× |△ |2016/1/3|男 | 12345| |● [4]| |× |△ |2016/1/4|男 | 1234500| |● [5]| |× |△ |2016/1/5|男 | 56321| |●
結果は
Sheet1に
|[A]|[B]|[C]|[D] |[E] |[F] |[G] |[H] |[I] |[J] |[K] [1]|年 |月 |日 |ID番号|氏名|フリガナ|生年月日|性別|キー番号| コード|所属 [2]| 28| 10| 1| |× |△ |2016/1/2|女 | 101| |● [3]| 28| 2| 19| |× |△ |2016/1/3|男 | 12345| |● [4]| 28| 2| 19| |× |△ |2016/1/4|男 | 1234500| |● [5]| 28| 2| 19| |× |△ |2016/1/5|男 | 56321| |●
実行前のSheet1のM列以降にもデータは入っていますが割愛いたします
Sheet2のF列にあるキー番号をSheet1のD列とマッチングさせ
Sheet2のA列〜H列までのデータをSeet1のD列〜K列までコピー。
K列以降左詰めです。
(大盛りがきつい年ごろ) 2016/02/26(金) 15:40
実行後はSheet1のA〜M列までのデータをマッチングしていたら
Sheet2のA〜H列のデータに変更。LとM列を削除し、以降の列を左づめです。
(大盛りがきつい年ごろ) 2016/02/26(金) 16:11
余計わからない・・・ なんで最初のSheet1と結果のSheet1の項目名が違うの? Sheet1で総当たりさせるのだから、Sheet1の項目が変わったらおかしくない? (稲葉) 2016/02/26(金) 16:24
説明が正しければ
Sheet1 がこうならば |[A] |[B] |[C] |[D] |[E] |[F] |[G] |[H]|[I]|[J]|[K]|[L] |[M] [1]|記録日(年)|記録日(月)|記録日(日)|キー番号 |氏名|フリガナ|性別|生 |年 |月 |日 |学校名|所属 [2]| 28| 10| 1| 101|××|△ |女 |平 | 10| 2| 11|● |● [3]| 28| 2| 19| 12345|××|△ |男 |昭 | 55| 7| 25|● |● [4]| 28| 2| 19| 1234500|××|△ |男 |昭 | 31| 12| 12|● |● [5]| 28| 2| 19| 56321|××|△ |男 |昭 | 56| 9| 24|● |●
実行結果のSheet1は |[A] |[B] |[C] |[D] |[E] |[F] |[G] |[H] |[I] |[J] |[K] |[L] |[M] [1]|記録日(年)|記録日(月)|記録日(日)|キー番号 |氏名|フリガナ|性別 |生 |年 |月 |日 |学校名|所属 [2]| 28| 10| 1| |× |△ |2016/1/2|女 | 101| |● |● |● [3]| 28| 2| 19| |× |△ |2016/1/3|男 | 12345| |● |● |● [4]| 28| 2| 19| |× |△ |2016/1/4|男 |1234500| |● |● |● [5]| 28| 2| 19| |× |△ |2016/1/5|男 | 56321| |● |● |●
こうならなくちゃいけないわけですよね? (稲葉) 2016/02/26(金) 16:29
Sheet1にSheet2のデータを入れるのですね?
そうすると、Sheet2で総当たりしたほうがいいと思いますが、 Sheet1の総当たりでいいのですか?
上にもこう書かれていましたが、
この仕様だとSheet2の総当たりにしないと都合が悪いということでしょうか。
Sheet1とSheet2の項目や順番が違うので、Sheet2の総当たりで考える方法を教えていただけないでしょうか。
(大盛りがきつい年ごろ) 2016/02/26(金) 17:55
そうじゃなくて、説明と表が違うと言ってるのです (稲葉) 2016/02/27(土) 09:45
私も理解できていませんし、問題解決にはならないかもしれませんが、 気になった所があるので
>'Sheet1のD列からJ列をSheet2のA列からHまでのものに更新 >r.Columns("D:J").Value = f.Columns("A:H").Value
使い方に誤解がありませんか お時間あれば下記をステップ実行で確認してみてください
Sub test() Dim r As Range
Set r = Range("D3")
r.Columns("D:J").Select r.Columns("A:G").Select r.EntireRow.Columns("D:J").Select Rows(r.Row).Columns("D:J").Select
End Sub
(マナ) 2016/02/27(土) 11:14
私も横からお邪魔虫で。
まず、Sheet1 と Sheet2 をマッチングして、新しいイメージを、Sheet3 につくるというところから始めてはいかがですか。 処理後、処理の元が消えてしまうのは、何かと面倒の元になりそう。
で、もしかしたら、質問者さんの意図の「Sheet1」は、全く新しい「Sheet3」だということでは? (Sheet1 直接でももちろんいいのですが、いずれにしても、Sheet1 を変更するのではなく置き換えるのでは?)
(β) 2016/02/27(土) 17:57
EntireRowを行全体取得専用の書式と勘違いしていました。
r.EntireRow.Columns("D:M").Value = f.EntireRow.Columns("A:J").Value
この記述でとりあえず思い通りの動作をしましたので、あとの細かい修正は
自力で行いたいと思います。
ありがとうございました。
(大盛りがきつい年ごろ) 2016/03/01(火) 09:09
もう、ご覧にならないかもしれませんが。
>>EntireRowを行全体取得専用の書式と勘違いしていました。
【書式】という用語はともかく、勘違いではないですよ。
EntireRow は、Rangeオブジェクトのプロパティで、その中には、そのRangeオブジェクトの列全体の領域オブジェクトが入ります。
r.EntireRow.Columns("D:M") は、EntireRow の中のD列〜M列 ということで、 EntireRow とは別物です。
(β) 2016/03/01(火) 18:55
sheet1に元データ、sheet2にマッチング用更新リストをそれぞれCSVを取り込んでからマッチングさせる手順を踏んでいますが、このたびマッチングする番号が、先頭に0が入ることが想定されることとなりました。
この場合、上記のプログラムでは、
1.手打ちでセルの表示形式を文字列にして先頭の0を表示させたあとマッチングさせるとマッチングはするが、マッチング後の表示形式が標準に戻り先頭の0が消える。
数が多いので手打ちがとても面倒なうえ、更新後も0を表示させたままにしておきたいのです。
2.CSVを外部から取り込む際、先頭の0が消える。(もしよろしければ文字列として取り込むコードを教えてください)
3.2があるため、現状はテキストファイルを外部から取り込むコマンドを選択し、文字列として読み込む設定にしている。
4.3の方法ではマッチングしない。(リストが更新されない)※ここが一番わからない
などなど、問題が出てきてしましました。
何度も申し訳ありませんが、ご教授いただければ幸いです。
(大盛りがきつい年ごろ) 2016/03/09(水) 13:05
自己解決いたしました。文字列の後ろにスペースが入っているせいでマッチングしなかったようでした。
ただ、相変わらずCSVを文字列として読み込むプログラムが分からず手作業で行っていますので
その方法を教えていただければ幸いです。
なにとぞよろしくお願い申し上げます。
(大盛りがきつい年ごろ) 2016/03/10(木) 11:07
(マナ) 2016/03/10(木) 23:20
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.