[[20160219150504]] 『2つのシートをマッチングして更新』(大盛りがきつい年ごろ) >>BOT

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『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

シート3にはデータはありません

稲葉様のご指摘の通り修正して、両方の番号を完全一致させて走らせてみたところ
シート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


For Each r In .Range("D2", .Cells(Rows.Count, "D").End(xlUp))

Seet1はD列を参照します
(大盛りがきつい年ごろ) 2016/02/26(金) 13:33


 二度手間は面倒なので、再現出来るように説明してください。
 現状では、Sheet2のF列になにが入力されているのかわかりません。

 レイアウトは
[[20110209184943]] 『[談]シートレイアウトの投稿どうしてますか?』(momo) 
 こちらのユーティリティを使うと便利です。

(稲葉) 2016/02/26(金) 14:39


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|●    |●        

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


このあたりを参考に検討してみてはどうでようか。
http://www11.plala.or.jp/koma_Excel/contents11/mame11053/mame1105310.html

(マナ) 2016/03/10(木) 23:20


コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.