[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『２つのシートをマッチングして更新』（大盛りがきつい年ごろ）
はじめまして
シート１
番号｜名前｜所属
シート２
番号｜名前｜所属
以上のようなデータが入った二つのシートを、番号をキーにして
名前もしくは所属の違う行を探し、あればシート１のそのデータを
シート２のデータに更新。また、そもそも番号が違うものは弾く(シート３にコピー)
ようなものを作りたいと思っています。
ただ、以下のコードだと、シート1の番号が一つでもシート２にないと
エラーが出てしまうので、これを直した上で番号の異なるシート２のデータを抽出したいです。
（逆は抽出できるのですが）
また、現状は抽出したものをシート２に残し残りをシート３へコピーするようになっているので、これを逆にしたいです。
改善策をご教授いただけないでしょうか？
なにとぞよろしくお願い申し上げます。
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
'シート２のＡ列を参照
Set c = Worksheets("Sheet2").Range("A:A").Find(what:=Cells(r, "A").Value, LookIn:=xlValues, lookat:=xlWhole)
'シート３コピー用
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
'シート２A列未参照を残し、残りをシート３へ
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
に直せばエラー消えませんか？
＞また、現状は抽出したものをシート２に残し残りをシート３へコピーするようになっているので、これを逆にしたいです。 逆って言うのはどういう意味で？ Sheet2にコピーという意味？ それとも全部コピーして消す？ （稲葉） 2016/02/19(金) 15:49
見落とし
'シート３コピー用
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
ありがとうございます
＞また、現状は抽出したものをシート２に残し残りをシート３へコピーするようになっているので、これを逆にしたいです。
逆って言うのはどういう意味で？
これは、抽出したデータ（番号の違うデータ）をシート３に移したいのですが、現状は番号のマッチしたデータがシート３にコピーされ、シート２から削除。となっているので、番号の異なるデータをシート３にコピーしたい私の理想と逆という意味です。言葉足らずで申し訳ありません。
また、ご指摘いただいたとおりに２か所修正いたしましたが、エラーが出ます。
cとccで紛らわしくて申し訳ありません。見落としがあるのかと・・・
ご再考のほどお願いできれば幸いです。
（大盛りがきつい年ごろ） 2016/02/19(金) 16:11
シート３に移すってことですが、シート３には既にデータはありますか？ 無ければシート２をコピーして、見つけた行を消せば自然と残りますが・・・ （稲葉） 2016/02/19(金) 16:19
稲葉様のご指摘の通り修正して、両方の番号を完全一致させて走らせてみたところ
シート２の一番上のデータのみシート３へコピー＆シート２から削除されました。
番号不一致の場合はエラーが出ます。
（大盛りがきつい年ごろ） 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|
Sheet３
|[A]|[B]
[11]| 5 |あ
このようにしたいです
（大盛りがきつい年ごろ） 2016/02/19(金) 17:01
実行結果のシート３は
|[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列）
思うようにコピーできません。
列に空欄ができたり、Ｄ列以降のデータがコピーされなかったりします。
(更新しないデータがＤ列以降にあります)
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のＦ列を参照してマッチングに変更
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
'///////////////////////////////////////////////
'このＡ列指定は
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はＤ列を参照します
（大盛りがきつい年ごろ） 2016/02/26(金) 13:33
二度手間は面倒なので、再現出来るように説明してください。 現状では、Sheet2のF列になにが入力されているのかわかりません。
レイアウトは [[20110209184943]] 『[談]シートレイアウトの投稿どうしてますか？』（ｍｏｍｏ） こちらのユーティリティを使うと便利です。
（稲葉） 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のＦ列にあるキー番号をSheet1のＤ列とマッチングさせ
Sheet2のＡ列〜Ｈ列までのデータをSeet1のＤ列〜Ｋ列までコピー。
Ｋ列以降左詰めです。
（大盛りがきつい年ごろ） 2016/02/26(金) 15:40
実行後はSheet1のＡ〜Ｍ列までのデータをマッチングしていたら
Sheet2のＡ〜Ｈ列のデータに変更。ＬとＭ列を削除し、以降の列を左づめです。
（大盛りがきつい年ごろ） 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が入ることが想定されることとなりました。
この場合、上記のプログラムでは、
１．手打ちでセルの表示形式を文字列にして先頭の0を表示させたあとマッチングさせるとマッチングはするが、マッチング後の表示形式が標準に戻り先頭の0が消える。
数が多いので手打ちがとても面倒なうえ、更新後も0を表示させたままにしておきたいのです。
２．CSVを外部から取り込む際、先頭の0が消える。(もしよろしければ文字列として取り込むコードを教えてください)
３．２があるため、現状はテキストファイルを外部から取り込むコマンドを選択し、文字列として読み込む設定にしている。
４．３の方法ではマッチングしない。(リストが更新されない)※ここが一番わからない
などなど、問題が出てきてしましました。
何度も申し訳ありませんが、ご教授いただければ幸いです。
（大盛りがきつい年ごろ） 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.