[[20190104142417]]　『データの追加と変更を自動的に実行してくれるマク』（生ねこ）　ページの最後に飛ぶ

『データの追加と変更を自動的に実行してくれるマクロコード』（生ねこ）

どなたか助けてください！
ＥＸＣＥＬ２０１０(元データー)に、ＣＳＶ(最新データー)を反映させて顧客情報を管理する際に、「新規の追加」と、「住所変更」を自動的に実行するマクロのコードを教えてください！
よろしくお願いします。

※元データー、最新データー共にＡ列～Ｙ列までの表で、「H列：客番」、「X列：住所」が入力されている
※元データーの項目欄は７行目／データーは８行目から（Ｈ８～客番が入力されている）
※最新データーの項目欄は１行目／データーは２行目から（Ｈ２～客番が入力されている）
※元データーは現在、1500行まで入力あり（随時、新規分の行追加あり）
※最新データーには、「Ｉ列：生年月日」欄が未入力で表示されるため、元データーに追加する新規分は生年月日を手入力する必要がある。
また、削除された顧客情報は最新データーには載らないが、元データーには残しておく必要がある。この二つの仕様は変更不可。

＜元データー＞
「H列：客番」、「Ｉ列：生年月日」、「X列：住所」
1000、Ｓ50/10/10、東京都新宿区
1500、Ｓ30/12/15、東京都渋谷区
2000、Ｓ40/11/20、神奈川県横浜市
3500、Ｓ45/10/30、千葉県千葉市
＜最新データー＞
「H列：客番」、「Ｉ列：生年月日」、「X列：住所」
1000、　　　　　　、東京都新宿区　　←変更なし
1500、　　　　　　、東京都世田谷区　　←住所変更
4000、　　　　　　、埼玉県さいたま市　←新規
5500、　　　　　　、栃木県宇都宮市　←新規
※元データーの客番2000、3500は削除されている

↓↓↓この様にしたい
＜元データー＞
「H列：客番」、「Ｉ列：生年月日」、「X列：住所」
1000、Ｓ50/10/10、東京都新宿区
1500、Ｓ30/12/15、東京都世田谷区　←住所変更
2000、Ｓ40/11/20、神奈川県横浜市
3500、Ｓ45/10/30、千葉県千葉市
4000、Ｈ8/5/25　、埼玉県さいたま市　←新規
5500、Ｈ2/10/1　、栃木県宇都宮市　←新規

よろしくお願いします。

＜使用 Excel：Excel2010、使用 OS：Windows7 ＞

Sub main()

    Dim dic As Object, k As Variant, msht As Worksheet, nsht As Worksheet, c As Range
    Set msht = Sheets("元データー")
    Set nsht = Sheets("最新データー")
    Set dic = CreateObject("Scripting.Dictionary")
    For Each c In nsht.Range("H2:H" & Rows.Count).SpecialCells(2)
        dic(c.Value) = c.Offset(, 16).Value
    Next c
    For Each c In msht.Range("H8:H" & Rows.Count).SpecialCells(2)
        If dic(c.Value) <> "" Then
        c.Offset(, 16).Value = dic(c.Value)
        dic(c.Value) = ""
        End If
    Next c
    For Each k In dic
        If dic(k) <> "" Then
            msht.Range("H" & Rows.Count).End(xlUp).Offset(1, 16).Value = dic(k)
            msht.Range("H" & Rows.Count).End(xlUp).Offset(1).Value = k
            MsgBox "客番" & k & "の生年月日入力要", vbInformation
        End If
    Next k
End Sub
（mm） 2019/01/04(金) 15:44

mmさま
ご回答頂きありがとうございます！
住所変更は完璧に出来ましたが、何故か新規分が元データーに反映されないのです。
どうしたらいいでしょうか？よろしくお願いします。

（生ねこ） 2019/01/04(金) 16:23

メッセージ「"客番ｘｘｘの生年月日入力要"」は表示されますか？

されるのであれば、元データのH列の最終行より下に余計なデータが入ってませんか？
（mm） 2019/01/04(金) 16:31

mmさま、返信ありがとうございます！
メッセージは表示されませんでした。
（生ねこ） 2019/01/04(金) 16:38

mmさま
すみません、出来ました。一件、住所が未登録のものがあったせいで出来なかった様です。

ただ元データにも最新データにもA列からY列までデータが入っていまして、
新規分はA列からY列までのデータを元データに追加したいのですが、その場合はどうしたらよいでしょうか？

（生ねこ） 2019/01/04(金) 16:46

Sub main()

    Dim dic As Object, k As Variant, msht As Worksheet, nsht As Worksheet, c As Range, lr As Long
    Set msht = Sheets("元データー")
    Set nsht = Sheets("最新データー")
    Set dic = CreateObject("Scripting.Dictionary")
    For Each c In nsht.Range("H2:H" & Rows.Count).SpecialCells(2)
        dic(c.Value) = c.Row
    Next c
    For Each c In msht.Range("H8:H" & Rows.Count).SpecialCells(2)
        If dic(c.Value) <> "" Then
        msht.Range("A" & c.Row & ":Y" & c.Row).Value = nsht.Range("A" & dic(c.Value) & ":Y" & dic(c.Value)).Value
        dic(c.Value) = ""
        End If
    Next c
    For Each k In dic
        If dic(k) <> "" Then
           lr = msht.Range("H" & Rows.Count).End(xlUp).Offset(1).Row
           msht.Range("A" & lr & ":Y" & lr).Value = nsht.Range("A" & dic(k) & ":Y" & dic(k)).Value
           MsgBox "客番" & k & "の生年月日入力要", vbInformation
        End If
    Next k
End Sub
（mm） 2019/01/04(金) 17:09

mmさま
出来ました！！！
本当に助かりました。ありがとうございました！
（生ねこ） 2019/01/04(金) 17:25

コメント返信：

[ 一覧(最新更新順) ]

[[20190104142417]] 『データの追加と変更を自動的に実行してくれるマク』（生ねこ） ページの最後に飛ぶ

[[20190104142417]]　『データの追加と変更を自動的に実行してくれるマク』（生ねこ）　ページの最後に飛ぶ