エクセルのマクロの質問です。通販の顧客管理をエクセルで行っています。注文があった時にファイル「顧客名簿」から注文者の名前とメールで検索し、顧客登録されていなければ「顧客名簿」に新規に登録するというマクロを作りたいと思います。

また顧客登録されていても「顧客名簿」に未登録の記載されていないデータがあれば記入できるようにしたいと考えています。今はこれを手作業で行っており、まず名前を検索、同一人物か確かめてからコピー&ペーストを繰り返すという作業で大変時間がかかります。またデータが「顧客名簿」入力されていない場合がよくありトラブルの元になっています。ここを何とか改善したいと思います。
マクロの知識が浅いため、解決方法そのものを教えていただければうれしいです。もしそのまま使える完全なコードややり方を回答していただいた回答者の方には500ポイントを差し上げます。よろしくお願いいたします。
※文字制限のため「顧客管理」のサンプルデータ、仕様の詳細はこの下にある「この質問・回答へのコメント」に記載いたします。

回答の条件
  • 1人10回まで
  • 登録:2008/05/18 19:14:17
  • 終了:2008/05/20 23:58:10

ベストアンサー

id:SALINGER No.4

SALINGER回答回数3454ベストアンサー獲得回数9692008/05/20 00:28:23

ポイント2500pt

「会員管理」→「顧客名簿」

Sub MacroKaiinTenki()
    Dim i As Integer
    Dim j As Integer
    Dim kokyaku_Last As Long            '顧客名簿の最終行
    Dim kaiin_Last As Long              '会員管理の最終行
    Dim KOmidasi_name(13) As String     '顧客名簿の見出の文字列
    Dim KAmidasi_name(9) As String      '会員管理の見出の文字列
    Dim KOmidasi_column(13) As Integer  '顧客名簿の見出の位置
    Dim KAmidasi_column(9) As Integer   '会員管理の見出の位置
    Dim r As Range
    Dim fSelect As Boolean              '名前が選択されているか
    Dim f As Boolean                    '登録済み顧客か
    Dim f2 As Boolean
    Dim myCount1 As Long                '登録済み顧客の転記数
    Dim myCount2 As Long                '新規登録顧客の転記数
    
    '顧客名簿の見出の文字列。シートを変更する場合はこちらも変更
    KOmidasi_name(0) = "名前"
    KOmidasi_name(1) = "フリガナ"
    KOmidasi_name(2) = "郵便番号"
    KOmidasi_name(3) = "住所"
    KOmidasi_name(4) = "電話番号"
    KOmidasi_name(5) = "メール"
    KOmidasi_name(6) = "携帯メール"
    KOmidasi_name(7) = "登録日"
    KOmidasi_name(8) = "会員期限"
    KOmidasi_name(9) = "連番"
    KOmidasi_name(10) = "誕生年"
    KOmidasi_name(11) = "誕生月"
    KOmidasi_name(12) = "誕生日"
    KOmidasi_name(13) = "修正日"
    
    '会員管理の見出の文字列。シートを変更する場合はこちらも変更
    KAmidasi_name(0) = "お名前"
    KAmidasi_name(1) = "フリガナ"
    KAmidasi_name(2) = "郵便番号"
    KAmidasi_name(3) = "住所"
    KAmidasi_name(4) = "電話番号"
    KAmidasi_name(5) = "メール"
    KAmidasi_name(6) = "携帯メール"
    KAmidasi_name(7) = "登録日"
    KAmidasi_name(8) = "情報1"
    KAmidasi_name(9) = "生年月日"
   
    Const kokyaku_Midasi As Long = 1    '顧客名簿の見出の行
    Const kaiin_Midasi As Long = 1      '会員管理の見出の行
    
    For j = 0 To 13
        For i = 1 To 256
            If Worksheets("顧客名簿").Cells(kokyaku_Midasi, i).Value = KOmidasi_name(j) Then
                KOmidasi_column(j) = i
                Exit For
            End If
        Next i
    Next j
    For i = 0 To 13
        If KOmidasi_column(i) = 0 Then
            MsgBox "顧客名簿の見出を確認してください"
            Exit Sub
        End If
    Next i
    For j = 0 To 9
        For i = 1 To 256
            If Worksheets("会員管理").Cells(kaiin_Midasi, i).Value = KAmidasi_name(j) Then
                KAmidasi_column(j) = i
                Exit For
            End If
        Next i
    Next j
    For i = 0 To 9
        If KAmidasi_column(i) = 0 Then
            MsgBox "会員管理の見出を確認してください"
            Exit Sub
        End If
    Next i
    
    kokyaku_Last = Worksheets("顧客名簿").Cells(Rows.Count, KOmidasi_column(0)).End(xlUp).Row
    kaiin_Last = Worksheets("会員管理").Cells(Rows.Count, Selection.Column).End(xlUp).Row
   
    '転記部分
    With Worksheets("顧客名簿")
        For Each r In Selection
            If r.Column = KAmidasi_column(0) And r.Row > kaiin_Midasi And r.Row <= kaiin_Last Then
                fSelect = True
                f = False
                For i = kokyaku_Midasi + 1 To kokyaku_Last
                    If Replace(.Cells(i, KOmidasi_column(0)).Value, " ", "", , , 1) = _
                        Replace(Worksheets("会員管理").Cells(r.Row, KAmidasi_column(0)).Value, " ", "", , , 1) And _
                        .Cells(i, KOmidasi_column(5)).Value = Worksheets("会員管理").Cells(r.Row, KAmidasi_column(5)).Value Then
                        f2 = False
                        f = True
                        If MsgBox("未登録データのみを追加する場合(通常)→「はい」" & vbCrLf & _
                            "全てのデータを上書きをする場合     →「いいえ」" & vbCrLf & _
                            "(上書きする場合は十分注意してください。)", vbQuestion + vbYesNo, _
                            "既存顧客に未登録データのみを追加しますか?") = vbYes Then
                            For j = 1 To 8
                                If .Cells(i, KOmidasi_column(j)).Value = "" And _
                                    Worksheets("会員管理").Cells(r.Row, KAmidasi_column(j)).Value <> "" Then
                                    Select Case j
                                        Case 1
                                            .Cells(kokyaku_Last, KOmidasi_column(1)).Value = _
                                                Replace(StrConv(Worksheets("会員管理").Cells(r.Row, KAmidasi_column(1)), vbWide), " ", "", , , 1)
                                            f2 = True
                                        Case 2
                                            .Cells(kokyaku_Last, KOmidasi_column(2)).Value = _
                                                Replace(Replace(Worksheets("会員管理").Cells(r.Row, KAmidasi_column(2)), "-", "", , , 1), "ー", "", , , 1)
                                            f2 = True
                                        Case 5
                                        Case Else
                                            .Cells(i, KOmidasi_column(j)).Value = Worksheets("会員管理").Cells(r.Row, KAmidasi_column(j)).Value
                                            f2 = True
                                    End Select
                                End If
                            Next j
                            If Worksheets("会員管理").Cells(r.Row, KAmidasi_column(9)).Value <> "" Then
                                If .Cells(i, KOmidasi_column(10)).Value = "" Then
                                    .Cells(i, KOmidasi_column(10)).Value = Year(DateValue(Worksheets("会員管理").Cells(r.Row, KAmidasi_column(9)).Value))
                                    f2 = True
                                End If
                                If .Cells(i, KOmidasi_column(11)).Value = "" Then
                                    .Cells(i, KOmidasi_column(11)).Value = Month(DateValue(Worksheets("会員管理").Cells(r.Row, KAmidasi_column(9)).Value))
                                    f2 = True
                                End If
                                If .Cells(i, KOmidasi_column(12)).Value = "" Then
                                    .Cells(i, KOmidasi_column(12)).Value = Day(DateValue(Worksheets("会員管理").Cells(r.Row, KAmidasi_column(9)).Value))
                                    f2 = True
                                End If
                            End If
                        Else
                            For j = 1 To 8
                                If Worksheets("会員管理").Cells(r.Row, KAmidasi_column(j)).Value <> "" Then
                                    Select Case j
                                        Case 1
                                            .Cells(kokyaku_Last, KOmidasi_column(1)).Value = _
                                                Replace(StrConv(Worksheets("会員管理").Cells(r.Row, KAmidasi_column(1)), vbWide), " ", "", , , 1)
                                            f2 = True
                                        Case 2
                                            .Cells(kokyaku_Last, KOmidasi_column(2)).Value = _
                                                Replace(Replace(Worksheets("会員管理").Cells(r.Row, KAmidasi_column(2)), "-", "", , , 1), "ー", "", , , 1)
                                            f2 = True
                                        Case 5
                                        Case Else
                                            .Cells(i, KOmidasi_column(j)).Value = Worksheets("会員管理").Cells(r.Row, KAmidasi_column(j)).Value
                                            f2 = True
                                    End Select
                                End If
                            Next j
                            If Worksheets("会員管理").Cells(r.Row, KAmidasi_column(9)).Value <> "" Then
                                .Cells(i, KOmidasi_column(10)).Value = Year(DateValue(Worksheets("会員管理").Cells(r.Row, KAmidasi_column(9)).Value))
                                .Cells(i, KOmidasi_column(11)).Value = Month(DateValue(Worksheets("会員管理").Cells(r.Row, KAmidasi_column(9)).Value))
                                .Cells(i, KOmidasi_column(12)).Value = Day(DateValue(Worksheets("会員管理").Cells(r.Row, KAmidasi_column(9)).Value))
                                f2 = True
                            End If
                        End If
                        .Cells(kokyaku_Last, KOmidasi_column(0)).Value = _
                            Replace(Worksheets("会員管理").Cells(r.Row, KAmidasi_column(0)).Value, " ", " ", , , vbBinaryCompare)
                        If f2 Then myCount1 = myCount1 + 1
                    End If
                Next i
                '新規登録の場合
                If f = False Then
                    kokyaku_Last = kokyaku_Last + 1
                    For j = 0 To 8
                        .Cells(kokyaku_Last, KOmidasi_column(j)).Value = _
                            Worksheets("会員管理").Cells(r.Row, KAmidasi_column(j)).Value
                    Next j
                    .Cells(kokyaku_Last, KOmidasi_column(0)).Value = _
                        Replace(Worksheets("会員管理").Cells(r.Row, KAmidasi_column(0)).Value, " ", " ", , , vbBinaryCompare)
                    .Cells(kokyaku_Last, KOmidasi_column(1)).Value = _
                        Replace(StrConv(Worksheets("会員管理").Cells(r.Row, KAmidasi_column(1)), vbWide), " ", "", , , 1)
                    .Cells(kokyaku_Last, KOmidasi_column(2)).Value = _
                        Replace(Replace(Worksheets("会員管理").Cells(r.Row, KAmidasi_column(2)), "-", "", , , 1), "ー", "", , , 1)
                    .Cells(kokyaku_Last, KOmidasi_column(13)).Value = Date
                    .Cells(kokyaku_Last, KOmidasi_column(9)).Value = .Cells(kokyaku_Last - 1, KOmidasi_column(9)) + 1
                    .Cells(kokyaku_Last, KOmidasi_column(10)).Value = Year(DateValue(Worksheets("会員管理").Cells(r.Row, KAmidasi_column(9)).Value))
                    .Cells(kokyaku_Last, KOmidasi_column(11)).Value = Month(DateValue(Worksheets("会員管理").Cells(r.Row, KAmidasi_column(9)).Value))
                    .Cells(kokyaku_Last, KOmidasi_column(12)).Value = Day(DateValue(Worksheets("会員管理").Cells(r.Row, KAmidasi_column(9)).Value))
                    myCount2 = myCount2 + 1
                End If
            End If
        Next r
    End With
    
    If fSelect Then
        If myCount1 = 0 And myCount2 = 0 Then
            MsgBox "追加・修正するデータはありませんでした"
        Else
            MsgBox "既存顧客を " & myCount1 & " 件修正しました" & vbCrLf & "新規顧客を " & myCount2 & " 件追加しました"
        End If
    Else
        MsgBox "操作が誤っています。会員管理で名前を選択してから実行してください"
    End If
End Sub
id:icta

> SALINGERさん

早々のご回答ありがとうございます。

こんなにも長いコードになってしまってさぞお時間がかかったことと思います。

マクロがあまりにおもしろいように動くので欲張ってしまい申し訳ありません。

さて、動作を確認してみたのですがある条件のもとでうまく希望通りの動作をしないことがあるようです。

いろいろ検証してみました。

1)空白セルがあるときにデータが入る位置が違う。「通販管理」→「顧客名簿」

○マクロ実行前

「顧客名簿」※フリガナが2行とも空白

連番 会員番号 旧会員番号 会員資格 名前 フリガナ 郵便番号 住所 電話番号 メール 携帯メール 誕生年 誕生月 誕生日 登録日 修正日 会員期限 DM 備考

534 C01812 1534 正 沖原 太郎  6313270 広島県XXXX 090-YYYY-ZZZZ CCC@BBB.CC     2008/4/4 2008/5/20

535 C01609 884 仮 保坂 次郎  1563567 横浜市XXXX 045-YYYY-ZZZZ DDD@BBB.CC     2008/4/4 2008/5/20

「通販管理」

連番 会員番号 旧会員番号 会員資格 名前 フリガナ 郵便番号 住所 電話番号 メール 注文番号 売上 商品番号 商品名 ポイント バッグポイント 累計ポイント コメント

13364 C01812 1534 正 沖原 太郎 オキハラ タロウ 631-3270 広島県XXXX 090-YYYY-ZZZZ CCC@BBB.CC 08051101 5000 A080607,C080402 OOキャミ2,JJジャケット3 2  179 本日より本会員。

13365 C01609 884 仮 保坂 次郎 ホサカ ジロウ 156ー3567 横浜市XXXX 045-YYYY-ZZZZ DDD@BBB.CC 08051201 9400 D070604,D080601,F080203 VVパンツM,EEパンツ2,GGショール 4  18 プレゼントに

○マクロ実行後※沖原、保坂を選択してマクロを実行→”未登録のデータのみを追加する(通常)→[はい]”

メッセージ「既存顧客を1件修正しました」

「顧客名簿」

連番 会員番号 旧会員番号 会員資格 名前 フリガナ 郵便番号 住所 電話番号 メール 携帯メール 誕生年 誕生月 誕生日 登録日 修正日 会員期限 DM 備考

534 C01812 1534 正 沖原 太郎  6313270 広島県XXXX 090-YYYY-ZZZZ CCC@BBB.CC     2008/4/4 2008/5/20

535 C01609 884 仮 保坂 次郎 オキハラタロウ 1563567 横浜市XXXX 045-YYYY-ZZZZ DDD@BBB.CC     2008/4/4 2008/5/20


○検証

・フリガナが正しく入らない。保坂に沖原のフリガナが入り、沖原のフリガナが空白のまま。

・マクロ実行→”上書きする→[いいえ]”を選んだ場合、メッセージ「既存顧客を2件修正しました」と表示されるが、結果は上と同じ。

▼正しい表示

「顧客名簿」

連番 会員番号 旧会員番号 会員資格 名前 フリガナ 郵便番号 住所 電話番号 メール 携帯メール 誕生年 誕生月 誕生日 登録日 修正日 会員期限 DM 備考

534 C01812 1534 正 沖原 太郎 オキハラタロウ 6313270 広島県XXXX 090-YYYY-ZZZZ CCC@BBB.CC  1975 10 21 2008/4/4 2008/5/20

535 C01609 884 仮 保坂 次郎 ホサカジロウ 1563567 横浜市XXXX 045-YYYY-ZZZZ DDD@BBB.CC  1977 2 26 2008/4/4 2008/5/20


2)「既存顧客に未登録データのみを追加しますか?」のダイアログが1件ごとに表示される。

これは恐らく仕様だと思われます。実際の運用では一度に500件ほど取り込むことがあり、毎回メッセージが表示されることになってしまいます。

データ転記時に各行に対して個別に"未登録データのみを追加"と"データの上書き"を選ぶことはないため、もしご面倒でなければ▼次のようなルーチンで動くと助かります。

「既存顧客に未登録データのみを追加しますか?」

 |

 +--[はい]→選択したすべてのデータは未登録データのみを追加する

 |

 +--[いいえ]→選択したすべてのデータは上書きする

 

 

 

3)生年月日を教えたくない人の対処

顧客が女性なため、生年月日を教えたくない人が5人に1人くらいいます。

このような人は「会員管理」で生年月日が以下のように表示されます。

19--/2/15 ※誕生年のみ教えたくない

19--/--/-- ※生年月日を教えたくない

生年月日にこのようなデータが混じっている時に「型が一致しません」と表示されてしまいます。

生年月日に"19--"、"--"が含まれる場合、これを空白セルにすることは可能でしょうか?


3)転記完了のメッセージを転記確認のメッセージにする

実際に運用してみてあることに気がつきました。

これは最初に希望した仕様の変更となります。余計なお手数を何度もおかけして大変心苦しいのでもし改変が簡単であればとしてご覧ください。

転記する人間を選ぶ時はほとんどの場合、事前に新規顧客が○人、既存顧客が○人とわかっています。

従ってマクロを実行したときに、「新規顧客が○件追加しました。既存顧客を○件修正しました」と作業完了後にメッセージが表示されるよりも作業前に「新規顧客を○件追加します。既存顧客を○件修正します。よろしいですか?[はい][いいえ]」の方が心理的に安心できるような気がしました。

もし何らかの条件が重なってマクロがうまく動作しないとき、メッセージを確認し、事前にわかっている件数と異なれば、マクロ作業を中止することができます。

最後にマクロの作業が終われば「転記は終了しました」というメッセージを出して、再度確認します。

顧客情報を変更するときは間違って他の顧客の情報と差し換わってしまわないか気にかかり、他のデータの取り扱いよりも慎重になるのでこのようなことに気が付きました。

「新規顧客を○件追加します。既存顧客を○件修正します。よろしいですか?」

 |

 +--[はい]→作業実行→メッセージ「転記は終了しました」

 |

 +--[いいえ]→マクロを抜ける→メッセージ「転記を中断します」

 

 

4)修正のはずだが余分な行が挿入される。「会員管理」→「顧客名簿」

○マクロ実行前

「顧客名簿」※フリガナが2行とも空白

連番 会員番号 旧会員番号 会員資格 名前 フリガナ 郵便番号 住所 電話番号 メール 携帯メール 誕生年 誕生月 誕生日 登録日 修正日 会員期限 DM 備考

534    松田 聖子  2270033 神奈川県xxxxxx 090xxxxxx aaaa@bbb.ne.jp  1975 10 21 2005/12/26 2008/5/20

535    中森 明菜  9391104 富山県xxxxxx 0766xxxxxx ccc@ddd.ne.jp  1977 2 26 2005/12/26 2008/5/20

「会員管理」

お名前 フリガナ 生年月日 年齢 性別 メール 携帯メール 郵便番号 住所 電話番号 FAX 日中連絡先 ポイント メルマガ 機種 情報1 情報2 登録日

松田 聖子 マツダ セイコ 1975/10/21  来店 aaaa@bbb.ne.jp  2270033 神奈川県xxxxxx 090xxxxxx  / 0 OK "other

"   2005/12/26

中森 明菜 ナカモリ アキナ 1977/2/26  来店 ccc@ddd.ne.jp  939-1104 富山県xxxxxx 0766xxxxxx  / 0 OK "other

"   2005/12/26

○マクロ実行後※松田、中森を選択してマクロを実行→”未登録のデータのみを追加する(通常)→[はい]”

メッセージ「既存顧客を1件修正しました。新規顧客を1件追加しました」

「顧客名簿」

連番 会員番号 旧会員番号 会員資格 名前 フリガナ 郵便番号 住所 電話番号 メール 携帯メール 誕生年 誕生月 誕生日 登録日 修正日 会員期限 DM 備考

534    松田 聖子  2270033 神奈川県xxxxxx 090xxxxxx aaaa@bbb.ne.jp  1975 10 21 2005/12/26 2008/5/20

535    松田 聖子 マツダセイコ 9391104 富山県xxxxxx 0766xxxxxx ccc@ddd.ne.jp  1977 2 26 2005/12/26 2008/5/20

536    中森 明菜 ナカモリアキナ 9391104 富山県xxxxxx 0766xxxxxx ccc@ddd.ne.jp  1977 2 26 2005/12/26 2008/5/20

○検証

・松田の行が新たに追加される

・マクロ実行→”上書きする→[いいえ]”を選んだ場合、メッセージ「既存顧客を1件修正しました。新規顧客を1件追加しました」と表示され、結果は上と同じ。

▼正しい表示

「顧客名簿」

連番 会員番号 旧会員番号 会員資格 名前 フリガナ 郵便番号 住所 電話番号 メール 携帯メール 誕生年 誕生月 誕生日 登録日 修正日 会員期限 DM 備考

534    松田 聖子 マツダセイコ 2270033 神奈川県xxxxxx 090xxxxxx aaaa@bbb.ne.jp  1975 10 21 2005/12/26 2008/5/20

535    中森 明菜 ナカモリアキナ 9391104 富山県xxxxxx 0766xxxxxx ccc@ddd.ne.jp  1977 2 26 2005/12/26 2008/5/20

2008/05/20 09:39:45

その他の回答(3件)

id:SALINGER No.1

SALINGER回答回数3454ベストアンサー獲得回数9692008/05/18 23:59:10

ありがとうございます。回答できるようになりました。

とりあえず半分 「通販管理」→「顧客名簿」 です。

Sub MacroTuuhanTenki()
    Dim i As Integer
    Dim j As Integer
    Dim kokyaku_Last As Long            '顧客名簿の最終行
    Dim tuuhan_Last As Long             '通販管理の最終行
    Dim KOmidasi_name(11) As String     '顧客名簿の見出の文字列
    Dim Tmidasi_name(9) As String       '通販管理の見出の文字列
    Dim KOmidasi_column(11) As Integer  '顧客名簿の見出の位置
    Dim Tmidasi_column(9) As Integer    '通販管理の見出の位置
    Dim r As Range
    Dim fSelect As Boolean              '名前が選択されているか
    Dim f As Boolean                    '登録済み顧客か
    Dim f2 As Boolean
    Dim myCount1 As Long                '登録済み顧客の転記数
    Dim myCount2 As Long                '新規登録顧客の転記数
    
    '顧客名簿の見出の文字列。シートを変更する場合はこちらも変更
    KOmidasi_name(0) = "会員番号"
    KOmidasi_name(1) = "旧会員番号"
    KOmidasi_name(2) = "会員資格"
    KOmidasi_name(3) = "名前"
    KOmidasi_name(4) = "フリガナ"
    KOmidasi_name(5) = "郵便番号"
    KOmidasi_name(6) = "住所"
    KOmidasi_name(7) = "電話番号"
    KOmidasi_name(8) = "メール"
    KOmidasi_name(9) = "登録日"
    KOmidasi_name(10) = "修正日"
    KOmidasi_name(11) = "連番"
    
    '通販管理の見出の文字列。シートを変更する場合はこちらも変更
    Tmidasi_name(0) = "会員番号"
    Tmidasi_name(1) = "旧会員番号"
    Tmidasi_name(2) = "会員資格"
    Tmidasi_name(3) = "名前"
    Tmidasi_name(4) = "フリガナ"
    Tmidasi_name(5) = "郵便番号"
    Tmidasi_name(6) = "住所"
    Tmidasi_name(7) = "電話番号"
    Tmidasi_name(8) = "メール"
    Tmidasi_name(9) = "登録日"
   
    Const kokyaku_Midasi As Long = 1    '顧客名簿の見出の行
    Const tuuhan_Midasi As Long = 1     '通販管理の見出の行
    
    For j = 0 To 11
        For i = 1 To 256
            If Worksheets("顧客名簿").Cells(kokyaku_Midasi, i).Value = KOmidasi_name(j) Then
                KOmidasi_column(j) = i
                Exit For
            End If
        Next i
    Next j
    For i = 0 To 11
        If KOmidasi_column(i) = 0 Then
            MsgBox "顧客名簿の見出を確認してください"
            Exit Sub
        End If
    Next i
    For j = 0 To 9
        For i = 1 To 256
            If Worksheets("通販管理").Cells(tuuhan_Midasi, i).Value = Tmidasi_name(j) Then
                Tmidasi_column(j) = i
                Exit For
            End If
        Next i
    Next j
    For i = 0 To 9
        If Tmidasi_column(i) = 0 Then
            MsgBox "通販管理の見出を確認してください"
            Exit Sub
        End If
    Next i
    
    kokyaku_Last = Worksheets("顧客名簿").Cells(Rows.Count, KOmidasi_column(0)).End(xlUp).Row
    tuuhan_Last = Worksheets("通販管理").Cells(Rows.Count, Selection.Column).End(xlUp).Row
   
    '転記部分
    With Worksheets("顧客名簿")
        For Each r In Selection
            If r.Column = Tmidasi_column(3) And r.Row > tuuhan_Midasi And r.Row <= tuuhan_Last Then
                fSelect = True
                f = False
                For i = kokyaku_Midasi + 1 To kokyaku_Last
                    If Replace(.Cells(i, KOmidasi_column(3)).Value, " ", "", , , 1) = _
                        Replace(Worksheets("通販管理").Cells(r.Row, Tmidasi_column(3)).Value, " ", "", , , 1) And _
                        .Cells(i, KOmidasi_column(8)).Value = Worksheets("通販管理").Cells(r.Row, Tmidasi_column(8)).Value Then
                        f2 = False
                        For j = 0 To 9
                            If .Cells(i, KOmidasi_column(j)).Value = "" And j <> 3 And j <> 8 Then
                                .Cells(i, KOmidasi_column(j)).Value = Worksheets("通販管理").Cells(r.Row, Tmidasi_column(j)).Value
                                f2 = True
                            End If
                        Next j
                        If f2 Then myCount1 = myCount1 + 1
                        f = True
                    End If
                Next i
                '新規登録の場合
                If f = False Then
                    kokyaku_Last = kokyaku_Last + 1
                    For j = 0 To 9
                        .Cells(kokyaku_Last, KOmidasi_column(j)).Value = _
                            Worksheets("通販管理").Cells(r.Row, Tmidasi_column(j)).Value
                    Next j
                    .Cells(kokyaku_Last, KOmidasi_column(3)).Value = _
                        Replace(Worksheets("通販管理").Cells(r.Row, Tmidasi_column(3)).Value, " ", "", , , 1)
                    .Cells(kokyaku_Last, KOmidasi_column(10)).Value = Date
                    .Cells(kokyaku_Last, KOmidasi_column(11)).Value = .Cells(kokyaku_Last - 1, KOmidasi_column(11)) + 1
                    myCount2 = myCount2 + 1
                End If
            End If
        Next r
    End With
    
    If fSelect Then
        If myCount1 = 0 And myCount2 = 0 Then
            MsgBox "追加・修正するデータはありませんでした"
        Else
            MsgBox "既存顧客を " & myCount1 & " 件修正しました" & vbCrLf & "新規顧客を " & myCount2 & " 件追加しました"
        End If
    Else
        MsgBox "操作が誤っています。通販管理で名前を選択してから実行してください"
    End If
End Sub

注)横に長い行ができてしまいました、プラウザの横幅が狭いと勝手にコードが右端で折り返されることがあるので、コピーするときは折り返されてるところは直してください。

id:icta

> SALINGERさん

ご返送遅くなりまして申し訳ありません。

電話回線の工事でネットにつなげずにおりました。

マクロは完全に希望通りの動作を確認し、大変うれしく思います。

最初はマクロ一つで「顧客管理」も「会員管理」も実行できるかなと思ったのですが、2つの方が後から手を加える時、判りやすくていいですね。

エラートラップにまで気を使っていただきありがとうございました。

なるほどこれは絶対必要ですね。

すべてのマクロに取り込むようにしてみます。

エラーや操作ミスの回避、表記の統一など実際の運用において今回のマクロにできれば以下のような機能を追加したいと思います。

1)は当初の仕様の前提と異なってしまうのですが、この作業も意外に多いことに気がつきました。

後出しで心苦しいのですがお力添えいただければ幸いです。

これまで手作業でコピー&ペーストを繰り返してきたのがマクロでショートカットを作るとワンクリック一発でできますね。

まるでマジックのようです。

「コピー&ペースト」という言葉を教えることから始めなければならないスタッフの教育でもこれなら簡単に説明ができます。

本当に大助かりです。

1)ダイアログの表示

・マクロを実行すると▼次のダイアログを表示し「データの追加」だけでなく「上書き」も可能にする。

『既存顧客の場合、データを上書きせず未登録データのみ追加します(通常)。「OK」をクリックしてください。

データの上書きをする場合は「上書きする」をクリックしてください。上書きする場合は十分注意してください。

[OK][上書きする]』

・[OK]をクリックした時は現在の仕様どおり、「上書きする」をクリックした時は判定に使った"名前"と"メール"以外を上書きする。但し、「会員管理」、「通販管理」の空データは「顧客名簿」に空データの上書きをしない。データが存在するもののみを上書きする。

2)表記の統一※名前、フリガナ、郵便番号、

・名前

「顧客名簿」「通販管理」「顧客管理」の"名前"列は同一人物かどうか判定するために姓と名の間のスペースを取り除いて判定するが、「顧客名簿」に出力するときは姓と名の間のスペースは見易さの点から残す。ただし表記を統一するため半角スペースは全角スペースに変換しておく。

例:「判定」 山本 太郎、田中 花子→→山本太郎、田中花子

  「出力」 山本 太郎、田中 花子→→山本 太郎、田中 花子

・フリガナ

携帯からの注文者は半角フリガナを使うことが多い。そのため半角フリガナは全角フリガナに変換。姓と名のスペースは名前と異なり全角、半角スペースを問わず取り除く。

例:ヤマモト タロウ、タナカ ハナコ→ヤマモトタロウ、タナカハナコ

・郵便番号

郵便番号のハイフンとそれに準ずるもの(ー,-,-)は取り除いて数字のみにする。

2008/05/19 18:16:05
id:SALINGER No.2

SALINGER回答回数3454ベストアンサー獲得回数9692008/05/19 01:16:20

最初の回答にデータに空白があると、修正していなくても1件修正となるエラーがありました。

「通販管理」→「顧客名簿」

Sub MacroTuuhanTenki()
    Dim i As Integer
    Dim j As Integer
    Dim kokyaku_Last As Long            '顧客名簿の最終行
    Dim tuuhan_Last As Long             '通販管理の最終行
    Dim KOmidasi_name(11) As String     '顧客名簿の見出の文字列
    Dim Tmidasi_name(9) As String       '通販管理の見出の文字列
    Dim KOmidasi_column(11) As Integer  '顧客名簿の見出の位置
    Dim Tmidasi_column(9) As Integer    '通販管理の見出の位置
    Dim r As Range
    Dim fSelect As Boolean              '名前が選択されているか
    Dim f As Boolean                    '登録済み顧客か
    Dim f2 As Boolean
    Dim myCount1 As Long                '登録済み顧客の転記数
    Dim myCount2 As Long                '新規登録顧客の転記数
    
    '顧客名簿の見出の文字列。シートを変更する場合はこちらも変更
    KOmidasi_name(0) = "会員番号"
    KOmidasi_name(1) = "旧会員番号"
    KOmidasi_name(2) = "会員資格"
    KOmidasi_name(3) = "名前"
    KOmidasi_name(4) = "フリガナ"
    KOmidasi_name(5) = "郵便番号"
    KOmidasi_name(6) = "住所"
    KOmidasi_name(7) = "電話番号"
    KOmidasi_name(8) = "メール"
    KOmidasi_name(9) = "登録日"
    KOmidasi_name(10) = "修正日"
    KOmidasi_name(11) = "連番"
    
    '通販管理の見出の文字列。シートを変更する場合はこちらも変更
    Tmidasi_name(0) = "会員番号"
    Tmidasi_name(1) = "旧会員番号"
    Tmidasi_name(2) = "会員資格"
    Tmidasi_name(3) = "名前"
    Tmidasi_name(4) = "フリガナ"
    Tmidasi_name(5) = "郵便番号"
    Tmidasi_name(6) = "住所"
    Tmidasi_name(7) = "電話番号"
    Tmidasi_name(8) = "メール"
    Tmidasi_name(9) = "登録日"
   
    Const kokyaku_Midasi As Long = 1    '顧客名簿の見出の行
    Const tuuhan_Midasi As Long = 1     '通販管理の見出の行
    
    For j = 0 To 11
        For i = 1 To 256
            If Worksheets("顧客名簿").Cells(kokyaku_Midasi, i).Value = KOmidasi_name(j) Then
                KOmidasi_column(j) = i
                Exit For
            End If
        Next i
    Next j
    For i = 0 To 11
        If KOmidasi_column(i) = 0 Then
            MsgBox "顧客名簿の見出を確認してください"
            Exit Sub
        End If
    Next i
    For j = 0 To 9
        For i = 1 To 256
            If Worksheets("通販管理").Cells(tuuhan_Midasi, i).Value = Tmidasi_name(j) Then
                Tmidasi_column(j) = i
                Exit For
            End If
        Next i
    Next j
    For i = 0 To 9
        If Tmidasi_column(i) = 0 Then
            MsgBox "通販管理の見出を確認してください"
            Exit Sub
        End If
    Next i
    
    kokyaku_Last = Worksheets("顧客名簿").Cells(Rows.Count, KOmidasi_column(0)).End(xlUp).Row
    tuuhan_Last = Worksheets("通販管理").Cells(Rows.Count, Selection.Column).End(xlUp).Row
   
    '転記部分
    With Worksheets("顧客名簿")
        For Each r In Selection
            If r.Column = Tmidasi_column(3) And r.Row > tuuhan_Midasi And r.Row <= tuuhan_Last Then
                fSelect = True
                f = False
                For i = kokyaku_Midasi + 1 To kokyaku_Last
                    If Replace(.Cells(i, KOmidasi_column(3)).Value, " ", "", , , 1) = _
                        Replace(Worksheets("通販管理").Cells(r.Row, Tmidasi_column(3)).Value, " ", "", , , 1) And _
                        .Cells(i, KOmidasi_column(8)).Value = Worksheets("通販管理").Cells(r.Row, Tmidasi_column(8)).Value Then
                        f2 = False
                        For j = 0 To 9
                            If .Cells(i, KOmidasi_column(j)).Value = "" And j <> 3 And j <> 8 And _
                                Worksheets("通販管理").Cells(r.Row, Tmidasi_column(j)).Value <> "" Then
                                .Cells(i, KOmidasi_column(j)).Value = Worksheets("通販管理").Cells(r.Row, Tmidasi_column(j)).Value
                                f2 = True
                            End If
                        Next j
                        If f2 Then myCount1 = myCount1 + 1
                        f = True
                    End If
                Next i
                '新規登録の場合
                If f = False Then
                    kokyaku_Last = kokyaku_Last + 1
                    For j = 0 To 9
                        .Cells(kokyaku_Last, KOmidasi_column(j)).Value = _
                            Worksheets("通販管理").Cells(r.Row, Tmidasi_column(j)).Value
                    Next j
                    .Cells(kokyaku_Last, KOmidasi_column(3)).Value = _
                        Replace(Worksheets("通販管理").Cells(r.Row, Tmidasi_column(3)).Value, " ", "", , , 1)
                    .Cells(kokyaku_Last, KOmidasi_column(10)).Value = Date
                    .Cells(kokyaku_Last, KOmidasi_column(11)).Value = .Cells(kokyaku_Last - 1, KOmidasi_column(11)) + 1
                    myCount2 = myCount2 + 1
                End If
            End If
        Next r
    End With
    
    If fSelect Then
        If myCount1 = 0 And myCount2 = 0 Then
            MsgBox "追加・修正するデータはありませんでした"
        Else
            MsgBox "既存顧客を " & myCount1 & " 件修正しました" & vbCrLf & "新規顧客を " & myCount2 & " 件追加しました"
        End If
    Else
        MsgBox "操作が誤っています。通販管理で名前を選択してから実行してください"
    End If
End Sub

「会員管理」→「顧客名簿」

Sub MacroKaiinTenki()
    Dim i As Integer
    Dim j As Integer
    Dim kokyaku_Last As Long            '顧客名簿の最終行
    Dim kaiin_Last As Long              '会員管理の最終行
    Dim KOmidasi_name(13) As String     '顧客名簿の見出の文字列
    Dim KAmidasi_name(9) As String      '会員管理の見出の文字列
    Dim KOmidasi_column(13) As Integer  '顧客名簿の見出の位置
    Dim KAmidasi_column(9) As Integer   '会員管理の見出の位置
    Dim r As Range
    Dim fSelect As Boolean              '名前が選択されているか
    Dim f As Boolean                    '登録済み顧客か
    Dim f2 As Boolean
    Dim myCount1 As Long                '登録済み顧客の転記数
    Dim myCount2 As Long                '新規登録顧客の転記数
    
    '顧客名簿の見出の文字列。シートを変更する場合はこちらも変更
    KOmidasi_name(0) = "名前"
    KOmidasi_name(1) = "フリガナ"
    KOmidasi_name(2) = "郵便番号"
    KOmidasi_name(3) = "住所"
    KOmidasi_name(4) = "電話番号"
    KOmidasi_name(5) = "メール"
    KOmidasi_name(6) = "携帯メール"
    KOmidasi_name(7) = "登録日"
    KOmidasi_name(8) = "会員期限"
    KOmidasi_name(9) = "連番"
    KOmidasi_name(10) = "誕生年"
    KOmidasi_name(11) = "誕生月"
    KOmidasi_name(12) = "誕生日"
    KOmidasi_name(13) = "修正日"
    
    '会員管理の見出の文字列。シートを変更する場合はこちらも変更
    KAmidasi_name(0) = "お名前"
    KAmidasi_name(1) = "フリガナ"
    KAmidasi_name(2) = "郵便番号"
    KAmidasi_name(3) = "住所"
    KAmidasi_name(4) = "電話番号"
    KAmidasi_name(5) = "メール"
    KAmidasi_name(6) = "携帯メール"
    KAmidasi_name(7) = "登録日"
    KAmidasi_name(8) = "情報1"
    KAmidasi_name(9) = "生年月日"
   
    Const kokyaku_Midasi As Long = 1    '顧客名簿の見出の行
    Const kaiin_Midasi As Long = 1      '会員管理の見出の行
    
    For j = 0 To 13
        For i = 1 To 256
            If Worksheets("顧客名簿").Cells(kokyaku_Midasi, i).Value = KOmidasi_name(j) Then
                KOmidasi_column(j) = i
                Exit For
            End If
        Next i
    Next j
    For i = 0 To 13
        If KOmidasi_column(i) = 0 Then
            MsgBox "顧客名簿の見出を確認してください"
            Exit Sub
        End If
    Next i
    For j = 0 To 9
        For i = 1 To 256
            If Worksheets("会員管理").Cells(kaiin_Midasi, i).Value = KAmidasi_name(j) Then
                KAmidasi_column(j) = i
                Exit For
            End If
        Next i
    Next j
    For i = 0 To 9
        If KAmidasi_column(i) = 0 Then
            MsgBox "会員管理の見出を確認してください"
            Exit Sub
        End If
    Next i
    
    kokyaku_Last = Worksheets("顧客名簿").Cells(Rows.Count, KOmidasi_column(0)).End(xlUp).Row
    kaiin_Last = Worksheets("会員管理").Cells(Rows.Count, Selection.Column).End(xlUp).Row
   
    '転記部分
    With Worksheets("顧客名簿")
        For Each r In Selection
            If r.Column = KAmidasi_column(0) And r.Row > kaiin_Midasi And r.Row <= kaiin_Last Then
                fSelect = True
                f = False
                For i = kokyaku_Midasi + 1 To kokyaku_Last
                    If Replace(.Cells(i, KOmidasi_column(0)).Value, " ", "", , , 1) = _
                        Replace(Worksheets("会員管理").Cells(r.Row, KAmidasi_column(0)).Value, " ", "", , , 1) And _
                        .Cells(i, KOmidasi_column(5)).Value = Worksheets("会員管理").Cells(r.Row, KAmidasi_column(5)).Value Then
                        f2 = False
                        For j = 0 To 8
                            If .Cells(i, KOmidasi_column(j)).Value = "" And j <> 0 And j <> 5 And _
                                Worksheets("会員管理").Cells(r.Row, KAmidasi_column(j)).Value <> "" Then
                                .Cells(i, KOmidasi_column(j)).Value = Worksheets("会員管理").Cells(r.Row, KAmidasi_column(j)).Value
                                f2 = True
                            End If
                        Next j
                        If Worksheets("会員管理").Cells(r.Row, KAmidasi_column(9)).Value <> "" Then
                            If .Cells(i, KOmidasi_column(10)).Value = "" Then
                                .Cells(i, KOmidasi_column(10)).Value = Year(DateValue(Worksheets("会員管理").Cells(r.Row, KAmidasi_column(9)).Value))
                                f2 = True
                            End If
                            If .Cells(i, KOmidasi_column(11)).Value = "" Then
                                .Cells(i, KOmidasi_column(11)).Value = Month(DateValue(Worksheets("会員管理").Cells(r.Row, KAmidasi_column(9)).Value))
                                f2 = True
                            End If
                            If .Cells(i, KOmidasi_column(12)).Value = "" Then
                                .Cells(i, KOmidasi_column(12)).Value = Day(DateValue(Worksheets("会員管理").Cells(r.Row, KAmidasi_column(9)).Value))
                                f2 = True
                            End If
                        End If
                        If f2 Then myCount1 = myCount1 + 1
                        f = True
                    End If
                Next i
                '新規登録の場合
                If f = False Then
                    kokyaku_Last = kokyaku_Last + 1
                    For j = 0 To 8
                        .Cells(kokyaku_Last, KOmidasi_column(j)).Value = _
                            Worksheets("会員管理").Cells(r.Row, KAmidasi_column(j)).Value
                    Next j
                    .Cells(kokyaku_Last, KOmidasi_column(0)).Value = _
                        Replace(Worksheets("会員管理").Cells(r.Row, KAmidasi_column(0)).Value, " ", "", , , 1)
                    .Cells(kokyaku_Last, KOmidasi_column(13)).Value = Date
                    .Cells(kokyaku_Last, KOmidasi_column(9)).Value = .Cells(kokyaku_Last - 1, KOmidasi_column(9)) + 1
                    .Cells(kokyaku_Last, KOmidasi_column(10)).Value = Year(DateValue(Worksheets("会員管理").Cells(r.Row, KAmidasi_column(9)).Value))
                    .Cells(kokyaku_Last, KOmidasi_column(11)).Value = Month(DateValue(Worksheets("会員管理").Cells(r.Row, KAmidasi_column(9)).Value))
                    .Cells(kokyaku_Last, KOmidasi_column(12)).Value = Day(DateValue(Worksheets("会員管理").Cells(r.Row, KAmidasi_column(9)).Value))
                    myCount2 = myCount2 + 1
                End If
            End If
        Next r
    End With
    
    If fSelect Then
        If myCount1 = 0 And myCount2 = 0 Then
            MsgBox "追加・修正するデータはありませんでした"
        Else
            MsgBox "既存顧客を " & myCount1 & " 件修正しました" & vbCrLf & "新規顧客を " & myCount2 & " 件追加しました"
        End If
    Else
        MsgBox "操作が誤っています。会員管理で名前を選択してから実行してください"
    End If
End Sub
id:SALINGER No.3

SALINGER回答回数3454ベストアンサー獲得回数9692008/05/19 23:42:13

はてなにアップするにはコードが長くなってきました。

メッセージボックスには上書きというボタンは無いので、ユーザーフォームで作ろうかとも思いましたが、

それは別の機会に作ってみればいいと思います。

それで、OK・上書きするの変わりにメッセージを変えてはい・いいえにしています。

不具合が見つかりましたら教えてください。修正します。

「通販管理」→「顧客名簿」

Sub MacroTuuhanTenki()
    Dim i As Integer
    Dim j As Integer
    Dim kokyaku_Last As Long            '顧客名簿の最終行
    Dim tuuhan_Last As Long             '通販管理の最終行
    Dim KOmidasi_name(11) As String     '顧客名簿の見出の文字列
    Dim Tmidasi_name(9) As String       '通販管理の見出の文字列
    Dim KOmidasi_column(11) As Integer  '顧客名簿の見出の位置
    Dim Tmidasi_column(9) As Integer    '通販管理の見出の位置
    Dim r As Range
    Dim fSelect As Boolean              '名前が選択されているか
    Dim f As Boolean                    '登録済み顧客か
    Dim f2 As Boolean
    Dim myCount1 As Long                '登録済み顧客の転記数
    Dim myCount2 As Long                '新規登録顧客の転記数
    
    '顧客名簿の見出の文字列。シートを変更する場合はこちらも変更
    KOmidasi_name(0) = "会員番号"
    KOmidasi_name(1) = "旧会員番号"
    KOmidasi_name(2) = "会員資格"
    KOmidasi_name(3) = "名前"
    KOmidasi_name(4) = "フリガナ"
    KOmidasi_name(5) = "郵便番号"
    KOmidasi_name(6) = "住所"
    KOmidasi_name(7) = "電話番号"
    KOmidasi_name(8) = "メール"
    KOmidasi_name(9) = "登録日"
    KOmidasi_name(10) = "修正日"
    KOmidasi_name(11) = "連番"
    
    '通販管理の見出の文字列。シートを変更する場合はこちらも変更
    Tmidasi_name(0) = "会員番号"
    Tmidasi_name(1) = "旧会員番号"
    Tmidasi_name(2) = "会員資格"
    Tmidasi_name(3) = "名前"
    Tmidasi_name(4) = "フリガナ"
    Tmidasi_name(5) = "郵便番号"
    Tmidasi_name(6) = "住所"
    Tmidasi_name(7) = "電話番号"
    Tmidasi_name(8) = "メール"
    Tmidasi_name(9) = "登録日"
   
    Const kokyaku_Midasi As Long = 1    '顧客名簿の見出の行
    Const tuuhan_Midasi As Long = 1     '通販管理の見出の行
    
    For j = 0 To 11
        For i = 1 To 256
            If Worksheets("顧客名簿").Cells(kokyaku_Midasi, i).Value = KOmidasi_name(j) Then
                KOmidasi_column(j) = i
                Exit For
            End If
        Next i
    Next j
    For i = 0 To 11
        If KOmidasi_column(i) = 0 Then
            MsgBox "顧客名簿の見出を確認してください"
            Exit Sub
        End If
    Next i
    For j = 0 To 9
        For i = 1 To 256
            If Worksheets("通販管理").Cells(tuuhan_Midasi, i).Value = Tmidasi_name(j) Then
                Tmidasi_column(j) = i
                Exit For
            End If
        Next i
    Next j
    For i = 0 To 9
        If Tmidasi_column(i) = 0 Then
            MsgBox "通販管理の見出を確認してください"
            Exit Sub
        End If
    Next i
    
    kokyaku_Last = Worksheets("顧客名簿").Cells(Rows.Count, KOmidasi_column(0)).End(xlUp).Row
    tuuhan_Last = Worksheets("通販管理").Cells(Rows.Count, Selection.Column).End(xlUp).Row
   
    '転記部分
    With Worksheets("顧客名簿")
        For Each r In Selection
            If r.Column = Tmidasi_column(3) And r.Row > tuuhan_Midasi And r.Row <= tuuhan_Last Then
                fSelect = True
                f = False
                For i = kokyaku_Midasi + 1 To kokyaku_Last
                    If Replace(.Cells(i, KOmidasi_column(3)).Value, " ", "", , , 1) = _
                        Replace(Worksheets("通販管理").Cells(r.Row, Tmidasi_column(3)).Value, " ", "", , , 1) And _
                        .Cells(i, KOmidasi_column(8)).Value = Worksheets("通販管理").Cells(r.Row, Tmidasi_column(8)).Value Then
                        f2 = False
                        f = True
                        If MsgBox("未登録データのみを追加する場合(通常)→「はい」" & vbCrLf & _
                            "全てのデータを上書きをする場合     →「いいえ」" & vbCrLf & _
                            "(上書きする場合は十分注意してください。)", vbQuestion + vbYesNo, _
                            "既存顧客に未登録データのみを追加しますか?") = vbYes Then
                            For j = 0 To 9
                                If .Cells(i, KOmidasi_column(j)).Value = "" And _
                                    Worksheets("通販管理").Cells(r.Row, Tmidasi_column(j)).Value <> "" Then
                                    Select Case j
                                        Case 3
                                        Case 4
                                            .Cells(kokyaku_Last, KOmidasi_column(4)).Value = _
                                                Replace(StrConv(Worksheets("通販管理").Cells(r.Row, Tmidasi_column(4)), vbWide), " ", "", , , 1)
                                            f2 = True
                                        Case 5
                                            .Cells(kokyaku_Last, KOmidasi_column(5)).Value = _
                                                Replace(Replace(Worksheets("通販管理").Cells(r.Row, Tmidasi_column(5)), "-", "", , , 1), "ー", "", , , 1)
                                            f2 = True
                                        Case 8
                                        Case Else
                                            .Cells(i, KOmidasi_column(j)).Value = Worksheets("通販管理").Cells(r.Row, Tmidasi_column(j)).Value
                                            f2 = True
                                    End Select
                                End If
                            Next j
                        Else
                            For j = 0 To 9
                                If Worksheets("通販管理").Cells(r.Row, Tmidasi_column(j)).Value <> "" Then
                                    Select Case j
                                        Case 3
                                        Case 4
                                            .Cells(kokyaku_Last, KOmidasi_column(4)).Value = _
                                                Replace(StrConv(Worksheets("通販管理").Cells(r.Row, Tmidasi_column(4)), vbWide), " ", "", , , 1)
                                            f2 = True
                                        Case 5
                                            .Cells(kokyaku_Last, KOmidasi_column(5)).Value = _
                                                Replace(Replace(Worksheets("通販管理").Cells(r.Row, Tmidasi_column(5)), "-", "", , , 1), "ー", "", , , 1)
                                            f2 = True
                                        Case 8
                                        Case Else
                                            .Cells(i, KOmidasi_column(j)).Value = Worksheets("通販管理").Cells(r.Row, Tmidasi_column(j)).Value
                                            f2 = True
                                    End Select
                                End If
                            Next j
                        End If
                        .Cells(i, KOmidasi_column(3)).Value = _
                            Replace(Worksheets("通販管理").Cells(r.Row, Tmidasi_column(3)).Value, " ", " ", , , vbBinaryCompare)
                        If f2 Then myCount1 = myCount1 + 1
                    End If
                Next i
                '新規登録の場合
                If f = False Then
                    kokyaku_Last = kokyaku_Last + 1
                    For j = 0 To 9
                        .Cells(kokyaku_Last, KOmidasi_column(j)).Value = _
                            Worksheets("通販管理").Cells(r.Row, Tmidasi_column(j)).Value
                    Next j
                    .Cells(kokyaku_Last, KOmidasi_column(3)).Value = _
                        Replace(Worksheets("通販管理").Cells(r.Row, Tmidasi_column(3)).Value, " ", " ", , , vbBinaryCompare)
                    .Cells(kokyaku_Last, KOmidasi_column(4)).Value = _
                        Replace(StrConv(Worksheets("通販管理").Cells(r.Row, Tmidasi_column(4)), vbWide), " ", "", , , 1)
                    .Cells(kokyaku_Last, KOmidasi_column(5)).Value = _
                        Replace(Replace(Worksheets("通販管理").Cells(r.Row, Tmidasi_column(5)), "-", "", , , 1), "ー", "", , , 1)
                    .Cells(kokyaku_Last, KOmidasi_column(10)).Value = Date
                    .Cells(kokyaku_Last, KOmidasi_column(11)).Value = .Cells(kokyaku_Last - 1, KOmidasi_column(11)) + 1
                    myCount2 = myCount2 + 1
                End If
            End If
        Next r
    End With
    
    If fSelect Then
        If myCount1 = 0 And myCount2 = 0 Then
            MsgBox "追加・修正するデータはありませんでした"
        Else
            MsgBox "既存顧客を " & myCount1 & " 件修正しました" & vbCrLf & "新規顧客を " & myCount2 & " 件追加しました"
        End If
    Else
        MsgBox "操作が誤っています。通販管理で名前を選択してから実行してください"
    End If
End Sub

「会員管理」→「顧客名簿」

Sub MacroKaiinTenki()
    Dim i As Integer
    Dim j As Integer
    Dim kokyaku_Last As Long            '顧客名簿の最終行
    Dim kaiin_Last As Long              '会員管理の最終行
    Dim KOmidasi_name(13) As String     '顧客名簿の見出の文字列
    Dim KAmidasi_name(9) As String      '会員管理の見出の文字列
    Dim KOmidasi_column(13) As Integer  '顧客名簿の見出の位置
    Dim KAmidasi_column(9) As Integer   '会員管理の見出の位置
    Dim r As Range
    Dim fSelect As Boolean              '名前が選択されているか
    Dim f As Boolean                    '登録済み顧客か
    Dim f2 As Boolean
    Dim myCount1 As Long                '登録済み顧客の転記数
    Dim myCount2 As Long                '新規登録顧客の転記数
    
    '顧客名簿の見出の文字列。シートを変更する場合はこちらも変更
    KOmidasi_name(0) = "名前"
    KOmidasi_name(1) = "フリガナ"
    KOmidasi_name(2) = "郵便番号"
    KOmidasi_name(3) = "住所"
    KOmidasi_name(4) = "電話番号"
    KOmidasi_name(5) = "メール"
    KOmidasi_name(6) = "携帯メール"
    KOmidasi_name(7) = "登録日"
    KOmidasi_name(8) = "会員期限"
    KOmidasi_name(9) = "連番"
    KOmidasi_name(10) = "誕生年"
    KOmidasi_name(11) = "誕生月"
    KOmidasi_name(12) = "誕生日"
    KOmidasi_name(13) = "修正日"
    
    '会員管理の見出の文字列。シートを変更する場合はこちらも変更
    KAmidasi_name(0) = "お名前"
    KAmidasi_name(1) = "フリガナ"
    KAmidasi_name(2) = "郵便番号"
    KAmidasi_name(3) = "住所"
    KAmidasi_name(4) = "電話番号"
    KAmidasi_name(5) = "メール"
    KAmidasi_name(6) = "携帯メール"
    KAmidasi_name(7) = "登録日"
    KAmidasi_name(8) = "情報1"
    KAmidasi_name(9) = "生年月日"
   
    Const kokyaku_Midasi As Long = 1    '顧客名簿の見出の行
    Const kaiin_Midasi As Long = 1      '会員管理の見出の行
    
    For j = 0 To 13
        For i = 1 To 256
            If Worksheets("顧客名簿").Cells(kokyaku_Midasi, i).Value = KOmidasi_name(j) Then
                KOmidasi_column(j) = i
                Exit For
            End If
        Next i
    Next j
    For i = 0 To 13
        If KOmidasi_column(i) = 0 Then
            MsgBox "顧客名簿の見出を確認してください"
            Exit Sub
        End If
    Next i
    For j = 0 To 9
        For i = 1 To 256
            If Worksheets("会員管理").Cells(kaiin_Midasi, i).Value = KAmidasi_name(j) Then
                KAmidasi_column(j) = i
                Exit For
            End If
        Next i
    Next j
    For i = 0 To 9
        If KAmidasi_column(i) = 0 Then
            MsgBox "会員管理の見出を確認してください"
            Exit Sub
        End If
    Next i
    
    kokyaku_Last = Worksheets("顧客名簿").Cells(Rows.Count, KOmidasi_column(0)).End(xlUp).Row
    kaiin_Last = Worksheets("会員管理").Cells(Rows.Count, Selection.Column).End(xlUp).Row
   
    '転記部分
    With Worksheets("顧客名簿")
        For Each r In Selection
            If r.Column = KAmidasi_column(0) And r.Row > kaiin_Midasi And r.Row <= kaiin_Last Then
                fSelect = True
                f = False
                For i = kokyaku_Midasi + 1 To kokyaku_Last
                    If Replace(.Cells(i, KOmidasi_column(0)).Value, " ", "", , , 1) = _
                        Replace(Worksheets("会員管理").Cells(r.Row, KAmidasi_column(0)).Value, " ", "", , , 1) And _
                        .Cells(i, KOmidasi_column(5)).Value = Worksheets("会員管理").Cells(r.Row, KAmidasi_column(5)).Value Then
                        f2 = False
                        f = True
                        If MsgBox("未登録データのみを追加する場合(通常)→「はい」" & vbCrLf & _
                            "全てのデータを上書きをする場合     →「いいえ」" & vbCrLf & _
                            "(上書きする場合は十分注意してください。)", vbQuestion + vbYesNo, _
                            "既存顧客に未登録データのみを追加しますか?") = vbYes Then
                            For j = 1 To 8
                                If .Cells(i, KOmidasi_column(j)).Value = "" And _
                                    Worksheets("会員管理").Cells(r.Row, KAmidasi_column(j)).Value <> "" Then
                                    Select Case j
                                        Case 1
                                            .Cells(kokyaku_Last, KOmidasi_column(1)).Value = _
                                                Replace(StrConv(Worksheets("会員管理").Cells(r.Row, KAmidasi_column(1)), vbWide), " ", "", , , 1)
                                            f2 = True
                                        Case 2
                                            .Cells(kokyaku_Last, KOmidasi_column(2)).Value = _
                                                Replace(Replace(Worksheets("会員管理").Cells(r.Row, KAmidasi_column(2)), "-", "", , , 1), "ー", "", , , 
id:SALINGER No.4

SALINGER回答回数3454ベストアンサー獲得回数9692008/05/20 00:28:23ここでベストアンサー

ポイント2500pt

「会員管理」→「顧客名簿」

Sub MacroKaiinTenki()
    Dim i As Integer
    Dim j As Integer
    Dim kokyaku_Last As Long            '顧客名簿の最終行
    Dim kaiin_Last As Long              '会員管理の最終行
    Dim KOmidasi_name(13) As String     '顧客名簿の見出の文字列
    Dim KAmidasi_name(9) As String      '会員管理の見出の文字列
    Dim KOmidasi_column(13) As Integer  '顧客名簿の見出の位置
    Dim KAmidasi_column(9) As Integer   '会員管理の見出の位置
    Dim r As Range
    Dim fSelect As Boolean              '名前が選択されているか
    Dim f As Boolean                    '登録済み顧客か
    Dim f2 As Boolean
    Dim myCount1 As Long                '登録済み顧客の転記数
    Dim myCount2 As Long                '新規登録顧客の転記数
    
    '顧客名簿の見出の文字列。シートを変更する場合はこちらも変更
    KOmidasi_name(0) = "名前"
    KOmidasi_name(1) = "フリガナ"
    KOmidasi_name(2) = "郵便番号"
    KOmidasi_name(3) = "住所"
    KOmidasi_name(4) = "電話番号"
    KOmidasi_name(5) = "メール"
    KOmidasi_name(6) = "携帯メール"
    KOmidasi_name(7) = "登録日"
    KOmidasi_name(8) = "会員期限"
    KOmidasi_name(9) = "連番"
    KOmidasi_name(10) = "誕生年"
    KOmidasi_name(11) = "誕生月"
    KOmidasi_name(12) = "誕生日"
    KOmidasi_name(13) = "修正日"
    
    '会員管理の見出の文字列。シートを変更する場合はこちらも変更
    KAmidasi_name(0) = "お名前"
    KAmidasi_name(1) = "フリガナ"
    KAmidasi_name(2) = "郵便番号"
    KAmidasi_name(3) = "住所"
    KAmidasi_name(4) = "電話番号"
    KAmidasi_name(5) = "メール"
    KAmidasi_name(6) = "携帯メール"
    KAmidasi_name(7) = "登録日"
    KAmidasi_name(8) = "情報1"
    KAmidasi_name(9) = "生年月日"
   
    Const kokyaku_Midasi As Long = 1    '顧客名簿の見出の行
    Const kaiin_Midasi As Long = 1      '会員管理の見出の行
    
    For j = 0 To 13
        For i = 1 To 256
            If Worksheets("顧客名簿").Cells(kokyaku_Midasi, i).Value = KOmidasi_name(j) Then
                KOmidasi_column(j) = i
                Exit For
            End If
        Next i
    Next j
    For i = 0 To 13
        If KOmidasi_column(i) = 0 Then
            MsgBox "顧客名簿の見出を確認してください"
            Exit Sub
        End If
    Next i
    For j = 0 To 9
        For i = 1 To 256
            If Worksheets("会員管理").Cells(kaiin_Midasi, i).Value = KAmidasi_name(j) Then
                KAmidasi_column(j) = i
                Exit For
            End If
        Next i
    Next j
    For i = 0 To 9
        If KAmidasi_column(i) = 0 Then
            MsgBox "会員管理の見出を確認してください"
            Exit Sub
        End If
    Next i
    
    kokyaku_Last = Worksheets("顧客名簿").Cells(Rows.Count, KOmidasi_column(0)).End(xlUp).Row
    kaiin_Last = Worksheets("会員管理").Cells(Rows.Count, Selection.Column).End(xlUp).Row
   
    '転記部分
    With Worksheets("顧客名簿")
        For Each r In Selection
            If r.Column = KAmidasi_column(0) And r.Row > kaiin_Midasi And r.Row <= kaiin_Last Then
                fSelect = True
                f = False
                For i = kokyaku_Midasi + 1 To kokyaku_Last
                    If Replace(.Cells(i, KOmidasi_column(0)).Value, " ", "", , , 1) = _
                        Replace(Worksheets("会員管理").Cells(r.Row, KAmidasi_column(0)).Value, " ", "", , , 1) And _
                        .Cells(i, KOmidasi_column(5)).Value = Worksheets("会員管理").Cells(r.Row, KAmidasi_column(5)).Value Then
                        f2 = False
                        f = True
                        If MsgBox("未登録データのみを追加する場合(通常)→「はい」" & vbCrLf & _
                            "全てのデータを上書きをする場合     →「いいえ」" & vbCrLf & _
                            "(上書きする場合は十分注意してください。)", vbQuestion + vbYesNo, _
                            "既存顧客に未登録データのみを追加しますか?") = vbYes Then
                            For j = 1 To 8
                                If .Cells(i, KOmidasi_column(j)).Value = "" And _
                                    Worksheets("会員管理").Cells(r.Row, KAmidasi_column(j)).Value <> "" Then
                                    Select Case j
                                        Case 1
                                            .Cells(kokyaku_Last, KOmidasi_column(1)).Value = _
                                                Replace(StrConv(Worksheets("会員管理").Cells(r.Row, KAmidasi_column(1)), vbWide), " ", "", , , 1)
                                            f2 = True
                                        Case 2
                                            .Cells(kokyaku_Last, KOmidasi_column(2)).Value = _
                                                Replace(Replace(Worksheets("会員管理").Cells(r.Row, KAmidasi_column(2)), "-", "", , , 1), "ー", "", , , 1)
                                            f2 = True
                                        Case 5
                                        Case Else
                                            .Cells(i, KOmidasi_column(j)).Value = Worksheets("会員管理").Cells(r.Row, KAmidasi_column(j)).Value
                                            f2 = True
                                    End Select
                                End If
                            Next j
                            If Worksheets("会員管理").Cells(r.Row, KAmidasi_column(9)).Value <> "" Then
                                If .Cells(i, KOmidasi_column(10)).Value = "" Then
                                    .Cells(i, KOmidasi_column(10)).Value = Year(DateValue(Worksheets("会員管理").Cells(r.Row, KAmidasi_column(9)).Value))
                                    f2 = True
                                End If
                                If .Cells(i, KOmidasi_column(11)).Value = "" Then
                                    .Cells(i, KOmidasi_column(11)).Value = Month(DateValue(Worksheets("会員管理").Cells(r.Row, KAmidasi_column(9)).Value))
                                    f2 = True
                                End If
                                If .Cells(i, KOmidasi_column(12)).Value = "" Then
                                    .Cells(i, KOmidasi_column(12)).Value = Day(DateValue(Worksheets("会員管理").Cells(r.Row, KAmidasi_column(9)).Value))
                                    f2 = True
                                End If
                            End If
                        Else
                            For j = 1 To 8
                                If Worksheets("会員管理").Cells(r.Row, KAmidasi_column(j)).Value <> "" Then
                                    Select Case j
                                        Case 1
                                            .Cells(kokyaku_Last, KOmidasi_column(1)).Value = _
                                                Replace(StrConv(Worksheets("会員管理").Cells(r.Row, KAmidasi_column(1)), vbWide), " ", "", , , 1)
                                            f2 = True
                                        Case 2
                                            .Cells(kokyaku_Last, KOmidasi_column(2)).Value = _
                                                Replace(Replace(Worksheets("会員管理").Cells(r.Row, KAmidasi_column(2)), "-", "", , , 1), "ー", "", , , 1)
                                            f2 = True
                                        Case 5
                                        Case Else
                                            .Cells(i, KOmidasi_column(j)).Value = Worksheets("会員管理").Cells(r.Row, KAmidasi_column(j)).Value
                                            f2 = True
                                    End Select
                                End If
                            Next j
                            If Worksheets("会員管理").Cells(r.Row, KAmidasi_column(9)).Value <> "" Then
                                .Cells(i, KOmidasi_column(10)).Value = Year(DateValue(Worksheets("会員管理").Cells(r.Row, KAmidasi_column(9)).Value))
                                .Cells(i, KOmidasi_column(11)).Value = Month(DateValue(Worksheets("会員管理").Cells(r.Row, KAmidasi_column(9)).Value))
                                .Cells(i, KOmidasi_column(12)).Value = Day(DateValue(Worksheets("会員管理").Cells(r.Row, KAmidasi_column(9)).Value))
                                f2 = True
                            End If
                        End If
                        .Cells(kokyaku_Last, KOmidasi_column(0)).Value = _
                            Replace(Worksheets("会員管理").Cells(r.Row, KAmidasi_column(0)).Value, " ", " ", , , vbBinaryCompare)
                        If f2 Then myCount1 = myCount1 + 1
                    End If
                Next i
                '新規登録の場合
                If f = False Then
                    kokyaku_Last = kokyaku_Last + 1
                    For j = 0 To 8
                        .Cells(kokyaku_Last, KOmidasi_column(j)).Value = _
                            Worksheets("会員管理").Cells(r.Row, KAmidasi_column(j)).Value
                    Next j
                    .Cells(kokyaku_Last, KOmidasi_column(0)).Value = _
                        Replace(Worksheets("会員管理").Cells(r.Row, KAmidasi_column(0)).Value, " ", " ", , , vbBinaryCompare)
                    .Cells(kokyaku_Last, KOmidasi_column(1)).Value = _
                        Replace(StrConv(Worksheets("会員管理").Cells(r.Row, KAmidasi_column(1)), vbWide), " ", "", , , 1)
                    .Cells(kokyaku_Last, KOmidasi_column(2)).Value = _
                        Replace(Replace(Worksheets("会員管理").Cells(r.Row, KAmidasi_column(2)), "-", "", , , 1), "ー", "", , , 1)
                    .Cells(kokyaku_Last, KOmidasi_column(13)).Value = Date
                    .Cells(kokyaku_Last, KOmidasi_column(9)).Value = .Cells(kokyaku_Last - 1, KOmidasi_column(9)) + 1
                    .Cells(kokyaku_Last, KOmidasi_column(10)).Value = Year(DateValue(Worksheets("会員管理").Cells(r.Row, KAmidasi_column(9)).Value))
                    .Cells(kokyaku_Last, KOmidasi_column(11)).Value = Month(DateValue(Worksheets("会員管理").Cells(r.Row, KAmidasi_column(9)).Value))
                    .Cells(kokyaku_Last, KOmidasi_column(12)).Value = Day(DateValue(Worksheets("会員管理").Cells(r.Row, KAmidasi_column(9)).Value))
                    myCount2 = myCount2 + 1
                End If
            End If
        Next r
    End With
    
    If fSelect Then
        If myCount1 = 0 And myCount2 = 0 Then
            MsgBox "追加・修正するデータはありませんでした"
        Else
            MsgBox "既存顧客を " & myCount1 & " 件修正しました" & vbCrLf & "新規顧客を " & myCount2 & " 件追加しました"
        End If
    Else
        MsgBox "操作が誤っています。会員管理で名前を選択してから実行してください"
    End If
End Sub
id:icta

> SALINGERさん

早々のご回答ありがとうございます。

こんなにも長いコードになってしまってさぞお時間がかかったことと思います。

マクロがあまりにおもしろいように動くので欲張ってしまい申し訳ありません。

さて、動作を確認してみたのですがある条件のもとでうまく希望通りの動作をしないことがあるようです。

いろいろ検証してみました。

1)空白セルがあるときにデータが入る位置が違う。「通販管理」→「顧客名簿」

○マクロ実行前

「顧客名簿」※フリガナが2行とも空白

連番 会員番号 旧会員番号 会員資格 名前 フリガナ 郵便番号 住所 電話番号 メール 携帯メール 誕生年 誕生月 誕生日 登録日 修正日 会員期限 DM 備考

534 C01812 1534 正 沖原 太郎  6313270 広島県XXXX 090-YYYY-ZZZZ CCC@BBB.CC     2008/4/4 2008/5/20

535 C01609 884 仮 保坂 次郎  1563567 横浜市XXXX 045-YYYY-ZZZZ DDD@BBB.CC     2008/4/4 2008/5/20

「通販管理」

連番 会員番号 旧会員番号 会員資格 名前 フリガナ 郵便番号 住所 電話番号 メール 注文番号 売上 商品番号 商品名 ポイント バッグポイント 累計ポイント コメント

13364 C01812 1534 正 沖原 太郎 オキハラ タロウ 631-3270 広島県XXXX 090-YYYY-ZZZZ CCC@BBB.CC 08051101 5000 A080607,C080402 OOキャミ2,JJジャケット3 2  179 本日より本会員。

13365 C01609 884 仮 保坂 次郎 ホサカ ジロウ 156ー3567 横浜市XXXX 045-YYYY-ZZZZ DDD@BBB.CC 08051201 9400 D070604,D080601,F080203 VVパンツM,EEパンツ2,GGショール 4  18 プレゼントに

○マクロ実行後※沖原、保坂を選択してマクロを実行→”未登録のデータのみを追加する(通常)→[はい]”

メッセージ「既存顧客を1件修正しました」

「顧客名簿」

連番 会員番号 旧会員番号 会員資格 名前 フリガナ 郵便番号 住所 電話番号 メール 携帯メール 誕生年 誕生月 誕生日 登録日 修正日 会員期限 DM 備考

534 C01812 1534 正 沖原 太郎  6313270 広島県XXXX 090-YYYY-ZZZZ CCC@BBB.CC     2008/4/4 2008/5/20

535 C01609 884 仮 保坂 次郎 オキハラタロウ 1563567 横浜市XXXX 045-YYYY-ZZZZ DDD@BBB.CC     2008/4/4 2008/5/20


○検証

・フリガナが正しく入らない。保坂に沖原のフリガナが入り、沖原のフリガナが空白のまま。

・マクロ実行→”上書きする→[いいえ]”を選んだ場合、メッセージ「既存顧客を2件修正しました」と表示されるが、結果は上と同じ。

▼正しい表示

「顧客名簿」

連番 会員番号 旧会員番号 会員資格 名前 フリガナ 郵便番号 住所 電話番号 メール 携帯メール 誕生年 誕生月 誕生日 登録日 修正日 会員期限 DM 備考

534 C01812 1534 正 沖原 太郎 オキハラタロウ 6313270 広島県XXXX 090-YYYY-ZZZZ CCC@BBB.CC  1975 10 21 2008/4/4 2008/5/20

535 C01609 884 仮 保坂 次郎 ホサカジロウ 1563567 横浜市XXXX 045-YYYY-ZZZZ DDD@BBB.CC  1977 2 26 2008/4/4 2008/5/20


2)「既存顧客に未登録データのみを追加しますか?」のダイアログが1件ごとに表示される。

これは恐らく仕様だと思われます。実際の運用では一度に500件ほど取り込むことがあり、毎回メッセージが表示されることになってしまいます。

データ転記時に各行に対して個別に"未登録データのみを追加"と"データの上書き"を選ぶことはないため、もしご面倒でなければ▼次のようなルーチンで動くと助かります。

「既存顧客に未登録データのみを追加しますか?」

 |

 +--[はい]→選択したすべてのデータは未登録データのみを追加する

 |

 +--[いいえ]→選択したすべてのデータは上書きする

 

 

 

3)生年月日を教えたくない人の対処

顧客が女性なため、生年月日を教えたくない人が5人に1人くらいいます。

このような人は「会員管理」で生年月日が以下のように表示されます。

19--/2/15 ※誕生年のみ教えたくない

19--/--/-- ※生年月日を教えたくない

生年月日にこのようなデータが混じっている時に「型が一致しません」と表示されてしまいます。

生年月日に"19--"、"--"が含まれる場合、これを空白セルにすることは可能でしょうか?


3)転記完了のメッセージを転記確認のメッセージにする

実際に運用してみてあることに気がつきました。

これは最初に希望した仕様の変更となります。余計なお手数を何度もおかけして大変心苦しいのでもし改変が簡単であればとしてご覧ください。

転記する人間を選ぶ時はほとんどの場合、事前に新規顧客が○人、既存顧客が○人とわかっています。

従ってマクロを実行したときに、「新規顧客が○件追加しました。既存顧客を○件修正しました」と作業完了後にメッセージが表示されるよりも作業前に「新規顧客を○件追加します。既存顧客を○件修正します。よろしいですか?[はい][いいえ]」の方が心理的に安心できるような気がしました。

もし何らかの条件が重なってマクロがうまく動作しないとき、メッセージを確認し、事前にわかっている件数と異なれば、マクロ作業を中止することができます。

最後にマクロの作業が終われば「転記は終了しました」というメッセージを出して、再度確認します。

顧客情報を変更するときは間違って他の顧客の情報と差し換わってしまわないか気にかかり、他のデータの取り扱いよりも慎重になるのでこのようなことに気が付きました。

「新規顧客を○件追加します。既存顧客を○件修正します。よろしいですか?」

 |

 +--[はい]→作業実行→メッセージ「転記は終了しました」

 |

 +--[いいえ]→マクロを抜ける→メッセージ「転記を中断します」

 

 

4)修正のはずだが余分な行が挿入される。「会員管理」→「顧客名簿」

○マクロ実行前

「顧客名簿」※フリガナが2行とも空白

連番 会員番号 旧会員番号 会員資格 名前 フリガナ 郵便番号 住所 電話番号 メール 携帯メール 誕生年 誕生月 誕生日 登録日 修正日 会員期限 DM 備考

534    松田 聖子  2270033 神奈川県xxxxxx 090xxxxxx aaaa@bbb.ne.jp  1975 10 21 2005/12/26 2008/5/20

535    中森 明菜  9391104 富山県xxxxxx 0766xxxxxx ccc@ddd.ne.jp  1977 2 26 2005/12/26 2008/5/20

「会員管理」

お名前 フリガナ 生年月日 年齢 性別 メール 携帯メール 郵便番号 住所 電話番号 FAX 日中連絡先 ポイント メルマガ 機種 情報1 情報2 登録日

松田 聖子 マツダ セイコ 1975/10/21  来店 aaaa@bbb.ne.jp  2270033 神奈川県xxxxxx 090xxxxxx  / 0 OK "other

"   2005/12/26

中森 明菜 ナカモリ アキナ 1977/2/26  来店 ccc@ddd.ne.jp  939-1104 富山県xxxxxx 0766xxxxxx  / 0 OK "other

"   2005/12/26

○マクロ実行後※松田、中森を選択してマクロを実行→”未登録のデータのみを追加する(通常)→[はい]”

メッセージ「既存顧客を1件修正しました。新規顧客を1件追加しました」

「顧客名簿」

連番 会員番号 旧会員番号 会員資格 名前 フリガナ 郵便番号 住所 電話番号 メール 携帯メール 誕生年 誕生月 誕生日 登録日 修正日 会員期限 DM 備考

534    松田 聖子  2270033 神奈川県xxxxxx 090xxxxxx aaaa@bbb.ne.jp  1975 10 21 2005/12/26 2008/5/20

535    松田 聖子 マツダセイコ 9391104 富山県xxxxxx 0766xxxxxx ccc@ddd.ne.jp  1977 2 26 2005/12/26 2008/5/20

536    中森 明菜 ナカモリアキナ 9391104 富山県xxxxxx 0766xxxxxx ccc@ddd.ne.jp  1977 2 26 2005/12/26 2008/5/20

○検証

・松田の行が新たに追加される

・マクロ実行→”上書きする→[いいえ]”を選んだ場合、メッセージ「既存顧客を1件修正しました。新規顧客を1件追加しました」と表示され、結果は上と同じ。

▼正しい表示

「顧客名簿」

連番 会員番号 旧会員番号 会員資格 名前 フリガナ 郵便番号 住所 電話番号 メール 携帯メール 誕生年 誕生月 誕生日 登録日 修正日 会員期限 DM 備考

534    松田 聖子 マツダセイコ 2270033 神奈川県xxxxxx 090xxxxxx aaaa@bbb.ne.jp  1975 10 21 2005/12/26 2008/5/20

535    中森 明菜 ナカモリアキナ 9391104 富山県xxxxxx 0766xxxxxx ccc@ddd.ne.jp  1977 2 26 2005/12/26 2008/5/20

2008/05/20 09:39:45
  • id:icta
    これはhttp://q.hatena.ne.jp/1210836514,http://q.hatena.ne.jp/1210860623,http://q.hatena.ne.jp/1210901281,http://q.hatena.ne.jp/1210987314,http://q.hatena.ne.jp/1210987314の派生質問です。
    データを記録するのはエクセルの知識がほとんどない販売スタッフです。データベースソフトを使えればよいのですが以前業者に依頼したものは導入に失敗しました。作業が煩雑になったのと各店舗に散らばるスタッフへの教育が難しく変更に対応できなかったためです。
    そのため現行作業をあまり変えることなく行うのが今回の方針です。


    「顧客名簿」※実店舗と通販の顧客情報をまとめたものです。店舗では住所などを聞かないことが多いのでデータは歯抜け状態です。
    連番 会員番号 旧会員番号 会員資格 名前 フリガナ 郵便番号 住所 電話番号 メール 携帯メール 誕生年 誕生月 誕生日 登録日 修正日 会員期限   
    62 C02022 1687 正 加藤 カトウ 020-0093 東京都XXXX  AAA@BBB.CC      2007/8/1    
    63 C03825 3825 正 山内 ヤマウチ 002-0093 東京都XXXX 03-YYYY-ZZZZ AAA@BBB.CC AAA@docomo.ne.jp 1976 6 28 2005/12/19     
    64 C03826 3826 正 藤下 フジシタ 340-0010 愛知県XXXX 090-YYYY-ZZZZ   1981 5 20 2005/12/19  2006/10/12~2007/10/12   
    65 C03827 3827 正 河西 カサイ    asai@ddddcom          

    「通販管理」※通販で顧客が注文したときに作られる顧客情報、購入情報をまとめたものです。
    連番 会員番号 旧会員番号 会員資格 名前 フリガナ 郵便番号 住所 電話番号 メール 登録日 注文番号 支払方法 売上 合計 商品番号 商品名 
    13362 C02022 1687 正 加藤 カトウ 020-0093 東京都XXXX 03-YYYY-ZZZZ AAA@BBB.CC 2006/10/1 08051018 カード 29000 29000 A080102,A080201 XXカットソー,IITシャツ 
    13363 C06760 2326 正 竹下 タケシタ 340-0010 愛知県XXXX 090-YYYY-ZZZZ BBB@AAA.CC 2005/3/22 08051019 郵振 2800 2200 A080201 IITシャツ 
    13364 C03839 3839 正 橋本 ハシモト 631-3270 広島県XXXX 090-YYYY-ZZZZ CCC@BBB.CC 2004/3/2 08051101 銀行 5000 4400 A080607,C080402 OOキャミ2,JJジャケット3 
    13365 C01609 884 仮 保坂 ホサカ 125-0010 横浜市XXXX 045-YYYY-ZZZZ DDD@BBB.CC 2007/4/1 08051201 郵振 9400 8800 D070604,D080601,F080203 VVパンツM,EEパンツ2,GGショール 

    「会員管理」※CSVデータ。「通販管理」とは別物で、顧客がカートを使用して購入した時に顧客情報がCSVデータとして作られるようになっています。
    会員ID お名前 フリガナ 生年月日 メール 携帯メール 郵便番号 住所 電話番号 情報1 登録日       
    zoop 深山 ミヤマ 1958/11/30 zoop@aaaa.com  184-3333 千葉県XXXX 043-YYYY-ZZZZ  2007/12/11       
    argare 竹田 タケダ 1969/6/16 argare@cccc.ne.jp kiyokiyoco@ezweb.ne.jp 268-4444 東京都XXXX 080-YYYY-ZZZZ  2007/12/11       
    asai 河西 カサイ 1966/9/4 asai@ddddcom BBB@docomo.ne.jp 304-5555 東京都XXXX 090-YYYY-ZZZZ  2007/12/12       
    AQ 高橋 タカハシ 1978/7/26 AQ@ffff.com  415-6666 神奈川県XXXX 090-YYYY-ZZZZ 2007/7/26-2008/7/25 2007/12/13       


    ■仕様

    ○概要
    「通販管理」、「会員管理」で「顧客名簿」に登録したい顧客の名前を選択。複数の場合もあり。マクロを実行すると選択した行のデータを配列に保存、「顧客名簿」から名前とメールを検索し、名前とメールが完全に一致する場合に同一人物と判断。一致しない場合は新規顧客として「顧客名簿」の最終行に顧客データを追加する。
    同一人物だった場合、名前とメール以外で未登録のデータ(空白セル)があれば配列に保存したデータを転記する。


    ○詳細※よくわからないので"配列"としましたが配列でなくても仕様に問題ありません。
    ・「顧客名簿」に登録したい顧客の名前を「通販管理」または「会員管理」から選択。選択は複数行の場合も、行をまたぐ場合もある。
    ・選択しているシートの1列1行目を以下の文字列で検索し、該当するものがあれば列位置を変数に保存する。
    会員番号,旧会員番号,会員資格,名前orお名前,フリガナ,郵便番号,住所,電話番号,メール,携帯メール,生年月日,情報1,登録日
    ※シートは「通販管理」、「会員管理」の2種類があり、上記のようにタイトル行に記載されたデータが異なる。そのため該当するデータのみの列位置を変数に保存する。またタイトル行の"名前"が"お名前"でも"名前"としてデータを保存する。
    ・選択しているセルの行で上記の文字列に一致するデータを配列に保存する。
    ・保存する時、名前は空白スペースが姓と名の間、名前の後ろに含まれていることがあるので全角スペース、半角スペースを取り除いてから保存する。
    ・「顧客名簿」の1行目を参照し、"メール"の列を探し、上記で配列に保存したメールと一致するか確かめる。
    ・一致すれば"名前"の列に記載された名前から上記と同じように全角スペースと半角スペースを取り除いたデータと配列に保存した名前が一致するか確かめる。
    ・両方が一致すれば同一人物であり既存顧客である。一致しなければ新規顧客である。
    ・既存顧客である場合は、配列に保存したデータと比較し、空白箇所(データ未登録箇所)があれば配列のデータを入れる。
    ・新規顧客である場合は、配列に保存したデータを「顧客名簿」の最終行に追加し、登録日を本日の日付とする。
    ・生年月日は1972/02/02ならば"/"で分解し、誕生年1972、誕生月2、誕生日2とする。
    ・「会員管理」の"情報1"は「顧客名簿」では"会員期限"である。
    ・複数の人間が操作するため、操作のあやまり防止用に次の機能と入れる。
     ※「顧客管理」「会員管理」シートの名前を選択しないでマクロを実行した時は「操作が誤っています。通販管理/会員管理で名前を選択してから実行してください」というエラーメッセージを出す。
     ※マクロを正常に終了したときは「××件の転記を終了しました」というメッセージを表示する。
     ※顧客情報が古いものか新しいものかわからなくなることがあるので、「顧客名簿」の既存顧客に新しい顧客情報のデータを追加したとき/新規顧客の顧客情報データを最終行に追加したときは「顧客名簿」の"修正日"列に本日の日付を記載する。
     マクロが無事に終了した時、「既存顧客を×件修正しました」、「新規顧客を×件追加しました」というメッセージを出す。


    ○実際の運用
    ・「通販管理」→「顧客名簿」
    1)「通販管理」から複数のセルを選択
    加藤、保坂を選択してマクロを実行
    「通販管理」
    連番 会員番号 旧会員番号 会員資格 名前 フリガナ 郵便番号 住所 電話番号 メール 登録日 注文番号 支払方法 売上 合計 商品番号 商品名 
    13362 C02022 1687 正 加藤 カトウ 020-0093 東京都XXXX 03-YYYY-ZZZZ AAA@BBB.CC 2006/10/1 08051018 カード 29000 29000 A080102,A080201 XXカットソー,IITシャツ 
    13363 C06760 2326 正 竹下 タケシタ 340-0010 愛知県XXXX 090-YYYY-ZZZZ BBB@AAA.CC 2005/3/22 08051019 郵振 2800 2200 A080201 IITシャツ 
    13364 C03839 3839 正 橋本 ハシモト 631-3270 広島県XXXX 090-YYYY-ZZZZ CCC@BBB.CC 2004/3/2 08051101 銀行 5000 4400 A080607,C080402 OOキャミ2,JJジャケット3 
    13365 C01609 884 仮 保坂 ホサカ 125-0010 横浜市XXXX 045-YYYY-ZZZZ DDD@BBB.CC 2007/4/1 08051201 郵振 9400 8800 D070604,D080601,F080203 VVパンツM,EEパンツ2,GGショール 

    2)顧客名簿に書き込み
    「顧客名簿」                 
    連番 会員番号 旧会員番号 会員資格 名前 フリガナ 郵便番号 住所 電話番号 メール 携帯メール 誕生年 誕生月 誕生日 登録日 修正日 会員期限   
    62 C02022 1687 正 加藤 カトウ 020-0093 東京都XXXX  AAA@BBB.CC      2007/8/1    
    63 C03825 3825 正 山内 ヤマウチ 002-0093 東京都XXXX 03-YYYY-ZZZZ AAA@BBB.CC AAA@docomo.ne.jp 1976 6 28 2005/12/19     
    64 C03826 3826 正 藤下 フジシタ 340-0010 愛知県XXXX 090-YYYY-ZZZZ   1981 5 20 2005/12/19  2006/10/12~2007/10/12   
    65 C03827 3827 正 河西 カサイ    asai@ddddcom          

    ※加藤は名前とメールが一致し既存顧客なので空白箇所(データ未登録箇所)※配列のデータの電話と登録日を入れる。
    ※保坂は「顧客名簿」の中で一致するデータがないので新規顧客。最終行に配列のデータを入れる。
    ※修正日に本日の日付を入れる。

    「顧客名簿」                 
    連番 会員番号 旧会員番号 会員資格 名前 フリガナ 郵便番号 住所 電話番号 メール 携帯メール 誕生年 誕生月 誕生日 登録日 修正日 会員期限   
    62 C02022 1687 正 加藤 カトウ 020-0093 東京都XXXX 03-YYYY-ZZZZ AAA@BBB.CC     2006/10/1 2008/5/18    
    63 C03825 3825 正 山内 ヤマウチ 002-0093 東京都XXXX 03-YYYY-ZZZZ AAA@BBB.CC AAA@docomo.ne.jp 1976 6 28 2005/12/19     
    64 C03826 3826 正 藤下 フジシタ 340-0010 愛知県XXXX 090-YYYY-ZZZZ   1981 5 20 2005/12/19  2006/10/12~2007/10/12   
    65 C03827 3827 正 河西 カサイ              
    66 C01609 884 仮 保坂 ホサカ 125-0010 横浜市XXXX 045-YYYY-ZZZZ DDD@BBB.CC     2007/4/1 2008/5/18    


    ・「会員管理」→「顧客名簿」
    1)「会員管理」から複数のセルを選択
    河西、高橋を選択してマクロを実行
    「会員管理」                 
    会員ID お名前 フリガナ 生年月日 メール 携帯メール 郵便番号 住所 電話番号 情報1 登録日       
    zoop 深山 ミヤマ 1958/11/30 zoop@aaaa.com  184-3333 千葉県XXXX 043-YYYY-ZZZZ  2007/12/11       
    argare 竹田 タケダ 1969/6/16 argare@cccc.ne.jp kiyokiyoco@ezweb.ne.jp 268-4444 東京都XXXX 080-YYYY-ZZZZ  2007/12/11       
    asai 河西 カサイ 1966/9/4 asai@ddddcom BBB@docomo.ne.jp 304-5555 東京都XXXX 090-YYYY-ZZZZ  2007/12/12       
    AQ 高橋 タカハシ 1978/7/26 AQ@ffff.com  415-6666 神奈川県XXXX 090-YYYY-ZZZZ 2007/7/26-2008/7/25 2007/12/13       

    2)顧客名簿に書き込み
    「顧客名簿」                 
    連番 会員番号 旧会員番号 会員資格 名前 フリガナ 郵便番号 住所 電話番号 メール 携帯メール 誕生年 誕生月 誕生日 登録日 修正日 会員期限   
    62 C02022 1687 正 加藤 カトウ 020-0093 東京都XXXX  AAA@BBB.CC      2007/8/1    
    63 C03825 3825 正 山内 ヤマウチ 002-0093 東京都XXXX 03-YYYY-ZZZZ AAA@BBB.CC AAA@docomo.ne.jp 1976 6 28 2005/12/19     
    64 C03826 3826 正 藤下 フジシタ 340-0010 愛知県XXXX 090-YYYY-ZZZZ   1981 5 20 2005/12/19  2006/10/12~2007/10/12   
    65 C03827 3827 正 河西 カサイ    asai@ddddcom          

    ※河西は名前とメールが一致し既存顧客なので空白箇所(データ未登録箇所)※配列のデータの郵便番号,住所,電話番号,携帯メール,誕生年,誕生月,誕生日,登録日を入れる。
    ※高橋は「顧客名簿」の中で一致するデータがないので新規顧客。最終行に配列のデータを入れる。
    ※修正日に本日の日付を入れる。

    「顧客名簿」                 
    連番 会員番号 旧会員番号 会員資格 名前 フリガナ 郵便番号 住所 電話番号 メール 携帯メール 誕生年 誕生月 誕生日 登録日 修正日 会員期限    
    62 C02022 1687 正 加藤 カトウ 020-0093 東京都XXXX  AAA@BBB.CC      2007/8/1     
    63 C03825 3825 正 山内 ヤマウチ 002-0093 東京都XXXX 03-YYYY-ZZZZ AAA@BBB.CC AAA@docomo.ne.jp 1976 6 28 2005/12/19      
    64 C03826 3826 正 藤下 フジシタ 340-0010 愛知県XXXX 090-YYYY-ZZZZ   1981 5 20 2005/12/19  2006/10/12~2007/10/12    
    65 C03827 3827 正 河西 カサイ 304-5555 東京都XXXX 090-YYYY-ZZZZ asai@ddddcom BBB@docomo.ne.jp 1966 9 4 2007/12/12 2008/5/18     
        高橋 タカハシ 415-6666 神奈川県XXXX 090-YYYY-ZZZZ AQ@ffff.com  1978 7 26 2007/12/13 2008/5/18 2007/7/26-2008/7/25    
  • id:taknt
    >今はこれを手作業で行っており、まず名前を検索、同一人物か確かめてからコピー&ペーストを繰り返すという作業で大変時間がかかります。

    注文伝票の入力作業を行う場合は、以下の流れとなる。

    1.顧客名から会員番号を検索する。
    2.そのときに、付随情報の確認をする。
    (住所、電話番号の変更や間違いがないかなどを確認(入力ミスがないかも含めて))
    3.それから 注文内容の入力。

    あと、住所やメルアドなど すべての行に持たせているが、それらを持たせる必要性は あるのか?
    私の意見として、それは、ないと思う(つまり、重複データ保持のために整合性がとれなくなるおそれがあるから)

    また、重複データを持たなければ、コピペもいらなくなるでしょう。

    注文用の入力フォームを作って、そこで入力して管理させるというようにしたらいいと思う。


    >またデータが「顧客名簿」入力されていない場合がよくありトラブルの元になっています。ここを何とか改善したいと思います。

    これは別の問題。入力せずして自動化なんてできるわけがない。
    台帳等に記載しなかったら(→ コンピューター化の場合は、入力)、トラブルが発生するのは当然。
    記載漏れをなくすには、あるタイミングで 注文伝票が きちんと入力されているのか確認する必要がある。
    エクセルとは関係のない話で、業務でカバーするしかない。
  • id:icta
    > takntさん

    ▼まずこちらをご確認ください。
    http://q.hatena.ne.jp/1210836514#c121702
    http://q.hatena.ne.jp/1210836514#c121761


    > 注文伝票の入力作業を行う場合は、以下の流れとなる。

    最初に提示した前提と異なっています。
    会員番号で検索するのではなく、名前とメールです。
    会員番号で検索しないのは理由があります。
    会員番号で検索するいうのは会員番号が必ず正しく入力されている前提に成り立っています。

    店舗と通販で異なる方法で会員番号を付与してきたためデータの活用ができなくなっているのが現状です。
    会員番号が複数与えられていたり、ダブっていたりします。
    それを改善するのが今回の目的なのです。
    今回の改善で顧客一人に統一した番号を与えることにしました。
    それが"会員番号"と"旧会員番号"なのです。
    改善がうまく行けば"会員番号"で検索するときが来ますが、それは今ではないのです。


    > あと、住所やメルアドなど すべての行に持たせているが、それらを持たせる必要性は あるのか?
    > 私の意見として、それは、ないと思う(つまり、重複データ保持のために整合性がとれなくなるおそれがあるから)
    > 注文用の入力フォームを作って、そこで入力して管理させるというようにしたらいいと思う。
    > これは別の問題。入力せずして自動化なんてできるわけがない。

    これは重々承知しております。
    システムを開発する人にとってはこれは当たり前のことだと思います。
    ただ今回の改善はコメント欄の冒頭にも書いておりますが、▼現行作業をあまり変えることなく行うことに重点を置いています。

    データを記録するのはエクセルの知識がほとんどない販売スタッフです。データベースソフトを使えればよいのですが以前業者に依頼したものは導入に失敗しました。作業が煩雑になったのと各店舗に散らばるスタッフへの教育が難しく変更に対応できなかったためです。
    そのため現行作業をあまり変えることなく行うのが今回の方針です。

    システム開発を行う人にとっては何でもないことでも、パソコンをワープロのように文書を清書するくらいの機械と思っている人間には何だかわけのわからないことに映ってしまうのです。
    それが前回の失敗でした。
    最新鋭の技術よりも今と変わらないことが大事なのです。

    システム開発の立場からの視点ではなく、パソコンを初めて触ったときのことを思い出して、パソコンを始めて触る人間が作業し、その人間が他の人間へ教育もするということを何卒ご理解ください。
  • id:SALINGER
    前回の質問でたくさんのポイントありがとうございます。
    そのせいか、心無いはてなユーザーからやっかみで回答拒否されたようです。
    この質問から回答拒否ユーザー数にひっかかるようになったので回答することはできません。
    顧客管理の作成を途中から手伝えなくなってしまって申し訳ありません。
  • id:icta
    > SALINGERさん
    ご丁寧にありがとうございます。
    うまく行くかどうかわかりませんが、オプションの「他ユーザーの設定による回答拒否」設定というのを見直してみました。
    お時間あるときに一度試してみてください。
  • id:taknt
    >、パソコンをワープロのように文書を清書するくらいの機械と思っている人間には何だかわけのわからないことに映ってしまうのです。

    清書する機械でいいのでは?
    清書するために いろいろ入力するだけですから。
    それで清書したものは、きちんと入力できたか 確認しますよね?
    清書レベルで運用するならば、それ以外は システムで補わないといけないでしょう。


    >ただ今回の改善はコメント欄の冒頭にも書いておりますが、▼現行作業をあまり変えることなく行うことに重点を置いています。

    トラブルが多発しているのに その現行作業を 変えないということですね。

    >データを記録するのはエクセルの知識がほとんどない販売スタッフです。
    エクセルを知らなくても使えるものじゃないとダメってことですよね。
    ということはエクセルでなくてもいいということ。
    逆にエクセル独自的なものがあると 弊害になるということでしょうか。

    >パソコンを始めて触る人間が作業し、その人間が他の人間へ教育もするということを何卒ご理解ください。
    パソコンを知らない人が 他の人間を教育するのは 間違ってます。
    教育しなくても使えるものじゃないと まわらないでしょう。


    ま、今まで 何回も質問しているようですが、ちょっと無理があるんじゃないのかなぁと思いますね。


    あと、
    >またデータが「顧客名簿」入力されていない場合がよくありトラブルの元になっています。
    >ここを何とか改善したいと思います。
    改善するということは、少なくても今までどおりのやり方を 変えないとダメでしょう。

    少なくとも 漏れなく 顧客名簿を 入力するには どうするか?
    ということですね。
    マクロを使えば もれなく顧客名簿が入っているのか?
    いいえ、入力もしないものが 入っているわけはありません。
    確実に入力する運用にしないとダメです。

    質問にあるこのへんのところは、マクロでは 解決しないでしょう。
    今までのやり方を変えない限り 無理でしょうね。

  • id:SALINGER
    補足。
    作成段階なのでエラートラップはしていませんが、実際の運用では予期せぬエラーが起こった場合、
    VBAの画面が出ても対処のしようがないので、エラートラップが必要になると思います。
    まず、マクロを実行する前には必ずバックアップを取らせます。
    エラートラップは次のような関数から呼び出すようにすれば、簡単に挿入できます。
    >>
    Sub マクロ通販転記()
    On Error GoTo ErrTrap

    Call MacroTuuhanTenki

    Exit Sub
    ErrTrap:
    MsgBox "予期せぬエラーが起こりました。エラーを修正するか正常に動作していたバックアップをお使いください。" & vbCrLf & "エラー番号 : " & Err.Number
    End Sub
    <<
  • id:SALINGER
    1つ確認させてください。
    既存顧客の場合、顧客管理の空白になっている部分だけ転記しています。
    空白になってなくて、例えば郵便番号が
    顧客名簿「1234567」、通販管理「090-1234」となっていた場合
    顧客名簿に「0901234」と入れた方がいいのでしょうか?
    また、顧客名簿「090-1234」、通販管理「090-1234」となっていた場合はどうでしょう?
  • id:icta
    説明不足で申し訳ありませんでした。
    以下のようになります。

    <転記>

    「通販管理」090-1234 
       ↓
    「顧客名簿」1234567

    ○[OK]をクリックした場合→転記しない
     「顧客名簿」1234567
     ※現在の仕様のまま。「顧客名簿」の内容を優先

    ○[上書き]をクリックした場合→転記する
     「顧客名簿」0901234
     ※ハイフンを取る。
     ※「通販管理」の内容を優先 

    何か他に不足の点がありましたらお知らせください。
  • id:SALINGER
    うお、コードが途中で切れましたね。
    投稿前の確認では切れてなかったけど。こんなに長い投稿は初めてでした。
  • id:SALINGER
    たぶん、1)と4)のエラー部分は
    MacroTuuhanTenki()の100行目くらいからはじまる
    Select Case j
    Case 1


    End Select
    の中の
    kokyaku_Last
    というのが2箇所、後に出てくるSelect~の中に2箇所あるので、それを
    i
    に変更することで修正できると思います。
    MacroKaiinTenki()も同じです。
  • id:icta
    > SALINGERさん
    早速のご回答ありがとうございます。
    上記の修正の件、MacroTuuhanTenki()に関してはうまく行きました。
    いろんなケースで検証してみましたが問題ありませんでした。
    しかしMacroKaiinTenki()に関しては同じように新たな1行が挿入されてしまいます。

    MacroKaiinTenki()の修正した箇所は▼次のとおりです。
    下記のkokyaku_Last4箇所すべてをiに変える。

    最初の
    Select Case j
    Case 1
    .Cells(kokyaku_Last, KOmidasi_column(1)).Value = _
    :
    .Cells(kokyaku_Last, KOmidasi_column(2)).Value = _
    :
    次の
    Select Case j
    Case 1
    .Cells(kokyaku_Last, KOmidasi_column(1)).Value = _
    :
    .Cells(kokyaku_Last, KOmidasi_column(2)).Value = _
    :

    お手数ばかりおかけして申し訳ありませんがお時間の都合のつくときにチェックしてみていただければうれしいです。
  • id:SALINGER
    もう一つ。
    MacroKaiinTenki()の下の方の青字(VBAでは緑)の
    「’新規登録」
    の上に5行のところにある
    kokyaku_Lastをiに。
    コピーしてコードを作ってたので、全部で9箇所のkokyaku_Lastを変更するのを忘れたみたいです。
  • id:SALINGER
    正確なことはわからないけど、300行くらいの回答をすると切れてしまうのかな。
    しかも、その後の横幅とかデザインとかがくずれてしまいました。
    それで、こちらの方にコードを載せました。(下記のトラックバック)
    http://d.hatena.ne.jp/SALINGER/20080520

    変更点は
    ・9箇所のkokyaku_Lastの修正
    ・メッセージボックスを一回に。ただ、全部新規でも確認することになってしまいましたが。
    ・日付に変換できない生年月日を空白として処理。
    ・画面のちらつきを押さえて高速化。たくさんの行を一度に追加するときに速度が違ってきます。
  • id:icta
    > SALINGERさん
    うまく行きました!
    いろいろ検証しましたが期待通りの動作を確認しました。
    本当にありがとうございます。
    これならスタッフにもできそうです。
  • id:icta
    > SALINGERさん
    トラックバック先確認しました。
    お気遣いありがとうございます。
    ほぼ希望通りの動作を確認しました。

    私の説明の書き方が大変まずくて、意図していることが誤って伝わってしまいました。
    生年月日のところなのですが、最後にこれ一点だけ修正をお願いできませんでしょうか?
    この質問はあとこれだけで終了させていただきます。
    お手数をおかけして本当に申し訳ありません。

    1972/3/22 ※通常の場合
    19--/2/15 ※誕生年のみ教えたくない場合
    19--/--/-- ※生年月日全部を教えたくない場合

    誕生年 誕生月 誕生日
    1972 3 22
    - 2 15
    - - -
    ※誕生年のみ教えたくない場合は誕生年のみ空白にする。
    ※生年月日全部を教えたくない場合はすべて空白にする。
    ※ハイフンは空白の意味。ハイフンを入れるということではない。


  • id:SALINGER
    ご依頼の生年月日の処理修正しました。
    簡単かなと思って作ったら意外と大変で、会員管理の方から呼び出す関数を3つ作って年、月、日を取得するようにしています。
    変更したのはMacroKaiinTenki()だけですが、
    最後のFunctionから始まる3つも一緒にコピーしてください。
    数字かどうかで判断してるので、1234/567/40 などありえない日付も入るようになっています。
    ここらへんは改良の余地があるかもしれません。
  • id:icta
    > SALINGERさん
    早々の修正ありがとうございました。
    生年月日の件、"/"をデータ区切りにして19--を空白に変換するだけなのかと思っていたのですが、そんな簡単に済む話ではなかったのですね。
    度重なる無理な要望に柔軟に応じてくださり本当にありがとうございました。
    大変長いマクロを2つも作っていただいたので、かかった労力には到底及びませんがお礼の気持ちにポイントを少し多めにしておきます。

    これで単調な繰り返し作業の90%までがマクロで解決することができました。
    後、マクロで解決したいのは▼次のものです。
    これらは今までのようにパソコンに不慣れなスタッフが作業するものではなく私がデータを有効に活用して経営に役立てるものです。
    ここのところ連続で投稿しているので、これらについてはまた後日改めて質問を投稿したいと思います。
    もしお時間ありましたらまたご協力いただければ幸いです。

    ○担当者別売上
    ピボットテーブルで解決できるかもしれませんが、週ごと月ごとにどのスタッフがいくら売り上げているか「来店記録」からデータを取り出したいと思っています。
    ただしスタッフたちがワースト3などが判ってしまうと士気にかかわると思うのでスタッフが見るシートにはベスト5のみを表示、私が見るものは全員分の成績を表示するようにしたいと考えています。一応ピボットテーブルで挑戦してみたのですが売上"日"別でしか担当者別売上を出せませんでした。
    ○ジャンル別売れ筋アイテム
    ジャンル別にどの商品が週ごと月ごとにいちばん売れているのか知りたいと思います。これもピボットテーブルで解決できるのかもしれません。これがあればお客様にこの商品が今一番売れていますという提案をデータを元にできると思います。
    ○売上の多い顧客の抽出
    特別会員システムを運営しており、特別会員は入会金を納めれば通常価格よりも割引で購入できます。特別会員が得をする分岐点は年10万円の購入です。顧客別の売上を調べ、まだ特別会員でない顧客の中から過去1年間に10万円以上の売上を持つ顧客を月ごとに抽出します。このデータを元に特別会員への入会を勧めます。
    全顧客の数%しかいない特別会員が全売上の4割弱を占めるので戦略的に非常に重要になっています。

  • id:SALINGER
    たくさんのポイントありがとうございます。
    ictaさんの質問は何がやりたいのかが具体的にわかる質問だったのでとても作りやすかったです。
    それに数回に分けて段階を踏むことで、最終的に複雑なプログラムを書くことができました。この質問が最初だったら作る気が起きなかったかもしれませんね。
    私も職場で現行の作業をExcelで簡略化できないかと工夫したりしていますが、他の人が使うことも考えて今までの方法をできるだけ壊さないように苦心しています。
    今回、回答することで、いろいろと勉強できました。また、機会がありましたらよろしくお願いします。
  • id:icta
    > SALINGERさん
    質問を締め切ったのに再度質問して申し訳ありません。
    実際に過去のデータをすべて転記しようと試したところ「通販管理」→「顧客名簿」で次の場合うまくいかないことが判明しました。
    ”会員番号が空白の場合、新規顧客がデータのいちばん最後に転記されず、空白行に上書きされてしまう。”

    会員番号の空白は顧客が会員カードを忘れた時や顧客名簿に該当する顧客名がなかった場合に会員番号を空白のままにすることが多いのです。
    恐らくデータのいちばん下の行を探すときに会員番号を見ているのだと思われます。
    もしそうだとしたら連番は必ず行に空白はないようにしていますので最終行の判定にはこちらを使っていただけませんでしょうか?

    再現すると▼このようになります。
    恐れ入りますが、お時間あるときにチェックしていただけませんでしょうか。よろしくお願いいたします。

    「顧客名簿」
    連番 会員番号 旧会員番号 会員資格 名前 フリガナ 郵便番号 住所 電話番号 メール 携帯メール 誕生年 誕生月 誕生日 登録日 修正日
    534 1534 正 沖原 太郎 オキハラタロウ 6313270 広島県XXXX 090-YYYY-ZZZZ CCC@BBB.CC 2008/4/4 2008/5/21
    535 884 仮 保坂 次郎 ホサカジロウ 1563567 横浜市XXXX 045-YYYY-ZZZZ DDD@BBB.CC 2008/4/4 2008/5/21

    ↓沖原と保坂の会員番号は空白になっている。

    「通販管理」
    連番 会員番号 旧会員番号 会員資格 名前 フリガナ 郵便番号 住所 電話番号 メール 注文番号
    13362 C02022 1687 正 加藤 カトウ 002-0093 東京都XXXX 03-YYYY-ZZZZ AAA@BBB.CC 08051018
    13363 C06760 2326 正 竹下 タケシタ 340-0010 愛知県XXXX 090-YYYY-ZZZZ BBB@AAA.CC 08051019
    13364 C01812 1534 正 沖原 太郎 オキハラ タロウ 631-3270 広島県XXXX 090-YYYY-ZZZZ CCC@BBB.CC 08051101
    13365 C01609 884 仮 保坂 次郎 ホサカ ジロウ 156ー3567 横浜市XXXX 045-YYYY-ZZZZ DDD@BBB.CC 08051201

    ↓加藤と竹下のみを選択してマクロを実行。

    「顧客名簿」
    連番 会員番号 旧会員番号 会員資格 名前 フリガナ 郵便番号 住所 電話番号 メール 携帯メール 誕生534 C02022 1687 正 加藤 カトウ 20093 東京都XXXX 03-YYYY-ZZZZ AAA@BBB.CC 2008/4/4 2008/5/21
    535 C06760 2326 正 竹下 タケシタ 3400010 愛知県XXXX 090-YYYY-ZZZZ BBB@AAA.CC 2008/4/4 2008/5/21

    ※本来は順に行が沖原、保坂、加藤、竹下と並ぶはずが、沖原、保坂の会員番号が空白だと加藤、竹下が上書きされてしまう。
  • id:SALINGER
    77行目で会員番号から最終行を取得しています
    kokyaku_Last = Worksheets("顧客名簿").Cells(Rows.Count, KOmidasi_column(0)).End(xlUp).Row
    ここのKOmidasi_column(0)というのが会員番号なので連番のKOmidasi_column(11)にしてください。
    ちなみに、会員管理のほうでは「名前」で最終行を取得しています。
    こちらでは連番はKOmidasi_column(8)なので修正したほうがいいですね。
    ブログのコードは修正しておきます。
  • id:icta
    > SALINGERさん
    ご連絡遅くなりまして申し訳ありません。
    早速の修正ありがとうございました。
    修正によって希望通りの動作を確認しました。
    ここ数日かけ、このマクロを用いて過去のデータから取り込んでいます。
    手作業で一件一件確かめていた頃を考えるとかかる時間は格段の違いがあり大変喜んでいます。

    さて、マクロ使用中に日をまたいで気が付いたのですが、修正日のところがうまく入らなくて困っています。
    修正日は新規顧客を追加した場合にのみ入るようになっているようで、修正日がすでに入力されていると、後でその行を修正した場合でも修正日が入りません。

    私の説明不足でうまく伝えられずに申し訳ありません。
    顧客情報は顧客の引越し、アドレス変更などでよく変わります。修正日は現在のデータが古いか新しいかの判断をするために大変重要なデータとなっています。
    質問終了後に何度もお願いするのは本当に心苦しいのですが、次のような仕様を入れることは可能でしょうか?
    ご都合のよいときにご覧いただければ幸いです。


    ○「新規顧客の場合、既存顧客でデータを追加および上書きした場合は修正日を本日のものに書き換える」

    「会員管理」
    名前 フリガナ 生年月日 メール 携帯メール 郵便番号 住所 電話番号 情報1 登録日
    沖原 太郎 オキハラタロウ CCC@BBB.CC 6313270 広島県XXXX 090-YYYY-ZZZZ 2008/4/4

    ↓沖原を選択してマクロを実行

    「顧客名簿」
    連番 会員番号 旧会員番号 会員資格 名前 フリガナ 郵便番号 住所 電話番号 メール 携帯メール 誕生年 誕生月 誕生日 登録日 修正日
    1339 534 1534 正 沖原 太郎 6313270 広島県XXXX 090-YYYY-ZZZZ CCC@BBB.CC 2008/4/4 2008/5/21

    ↓沖原のフリガナが空白。「会員管理」には沖原のフリガナ"オキハラタロウ"が存在する。
    ↓従って"オキハラタロウ"を「顧客名簿」に入れる。
    ↓データの修正があったので修正日5/21を本日の日付5/23に書き換える。
    ↓既存顧客を上書きした場合も同様に書き換える。
    ↓新規顧客の場合も修正日に本日の日付を入れる。

    「顧客名簿」
    連番 会員番号 旧会員番号 会員資格 名前 フリガナ 郵便番号 住所 電話番号 メール 携帯メール 誕生年 誕生月 誕生日 登録日 修正日
    1339 534 1534 正 沖原 太郎 オキハラタロウ 6313270 広島県XXXX 090-YYYY-ZZZZ CCC@BBB.CC 2008/4/4 2008/5/23
  • id:SALINGER
    修正日については新規登録だけだと思っていました。
    ブログの方のコードを修正しておきます。
    *前のコメントは8ではなくて9でした。
  • id:icta
    > SALINGERさん
    ご連絡遅くなりまして申し訳ありません。
    早速の修正ありがとうございました。
    修正によって希望通りの動作を確認しました。
    このマクロによって過去に無造作に集められた万単位のデータを効率的に修正することができます
    本当にありがとうございました。

    これとは別件ですが、新しいマクロの質問を投稿しました。
    http://q.hatena.ne.jp/1211716499
    日常の作業ではこれがいちばんよく使うものになると思います。
    またお力をお借りすることができれば幸いです。

この質問への反応(ブックマークコメント)

トラックバック

「あの人に答えてほしい」「この質問はあの人が答えられそう」というときに、回答リクエストを送ってみてましょう。

これ以上回答リクエストを送信することはできません。制限について

絞り込み :
はてなココの「ともだち」を表示します。
回答リクエストを送信したユーザーはいません