[[20150422102657]] 『重複氏名のお知らせ確認』(ルイージ) ページの最後に飛ぶ

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

 

『重複氏名のお知らせ確認』(ルイージ)

いつもお世話になってます。

エクセルで顧客データの台帳を作成しており、
フォーム上で、データの登録・更新・削除を行っているのですが、
登録時に、氏名の重複確認を行い、重複がある場合、
メッセージボックスで、同じ氏名があることをお知らせしたいです。
同姓同名もありえますので、あくまでお知らせだけしたいと考えております。

具体的には、
登録時に、テキストボックスに入力した氏名から、
(登録ボタンを押した時)Sheet2 B列から重複確認を行い、
重複があれば、メッセージボックス(Yes or No)でお知らせし、
Yesなら登録、Noなら登録しない様に出来たらと考えております。
(氏名は、必ずSheet2のB列に登録してます)

尚、
現状の登録時のコードに組み合わせたいと考えております。
下記にコードを示しますので、ヒントでも構いませんので、
ご教授頂ければ幸いで御座います。宜しくお願い致します。

 Private Sub CommandButton登録_Click()
  Dim ACR As Long
  Dim exiWB As String
  Dim A As Workbook

  Set A = ThisWorkbook
  exiWB = ThisWorkbook.Name
  Windows(exiWB).Activate
  Worksheets("Sheet2").Activate
  ans = MsgBox("顧客情報を登録しますか?", _
  vbOKCancel + vbExclamation, "登録確認")
  If ans = vbCancel Then Exit Sub
  If ans = vbOK Then
  If Not TextBox氏名.Value = Empty Then
  If Not TextBox氏名 Is Nothing Then
     Range("Sheet2!a65536").End(xlUp).Offset(1).Select
     ACR = ActiveCell.Row
    Cells(ACR, 1).Value = コードNo.Value
    Cells(ACR, 2).Value = 氏名.Value
    Cells(ACR, 3).Value = フリガナ.Value
    Cells(ACR, 4).Value = 営業
    Cells(ACR, 5).Value = ID
    Cells(ACR, 6).Value = 契約日
    Cells(ACR, 7).Value = 引渡日
    Cells(ACR, 8).Value = 〒
    Cells(ACR, 9).Value = 住所1
    Cells(ACR, 10).Value = 住所2
    Cells(ACR, 11).Value = TEL
    Cells(ACR, 12).Value = 勤務先
    Cells(ACR, 13).Value = 勤務先TEL
    Cells(ACR, 14).Value = 連名1
    Cells(ACR, 15).Value = 連名2
    Cells(ACR, 16).Value = 連名3
    Cells(ACR, 17).Value = TextBox備考
    TextBoxコードNo.SetFocus

 ActiveCell.Offset(0).Activate
   MsgBox "登録しました。"
     CommandButton登録.Enabled = False
     CommandButton更新.Enabled = True
     CommandButton新規.Enabled = True
     CommandButton削除.Enabled = True
   Else

     MsgBox "氏名が登録されていません。"
          氏名.Value = Empty
          CommandButton登録.Enabled = True
          CommandButton更新.Enabled = False
          CommandButton新規.Enabled = True
          CommandButton削除.Enabled = False
    End If
  Else
     MsgBox "登録する氏名を入力して下さい。"
     CommandButton登録.Enabled = True
     CommandButton更新.Enabled = False
     CommandButton新規.Enabled = True
     CommandButton削除.Enabled = False
    End If
    End If
    Windows(exiWB).Activate
    Worksheets("Sheet1").Select
    End Sub

< 使用 アプリ:Excel2000、使用 OS:WindowsXP >


 直接の回答ではないですが。

 氏名だけでいいのですか?
 役職や住所なども合わせてチェックした方がいいのでは?

 たとえば、同姓同名、同じ人物でも複数の会社の役員を兼任してるなど。
(カリーニン) 2015/04/22(水) 11:06

カリーニンさん

早速のコメントありがとうございます。
当初は、住所等もチェックを考えていたのですが、
過去ログを拝見したら、重複チェックには時間がかかると
記載されておりましので、氏名だけに絞った次第です。
(ルイージ) 2015/04/22(水) 11:13


 なら、重複した氏名が出たら、住所や役職といった情報を
 メッセージボックス乃至フォームに表示させて
 ユーザーが判断できるようにすれば、もう少し便利ですよね!!
(稲葉) 2015/04/22(水) 11:17

稲葉さん

コメントありがとうございます。
登録ボタンを押した時に、重複チェックをするという事は、
氏名以外の情報も入力した後の可能性があり、且つ、
先に入力している同じ氏名の方が、入力情報が少ない場合もありえますので、
仰る通り、メッセージボックスに他の情報も載せ、
ユーザーが判断できるようにする方が、かなり便利です
ですが、私には難しそうです。。。
(ルイージ) 2015/04/22(水) 13:04


 カリーニンさんが戻られるまでのつなぎで

 別のユーザーフォームにリストで表示させて、上書きなら既存のコードの
 変数ACR に行番号を渡す、なんて方法はどうですか??
 少し書いてみますが
(稲葉) 2015/04/22(水) 14:53

 極力元のコードをいじらない方向で
 UserForm2を追加してください
 追加したフォームに、以下のコードを入れてください。

    '=======================================================
    'UserForm2を作って、コードを入れてください
    '=======================================================
    Option Explicit
    Private Const MaxCol As Long = 17
    Private Const lstVal As Long = 1
    Private WithEvents btnCancel As MSForms.CommandButton
    Private WithEvents btnSave   As MSForms.CommandButton
    Private lstCst               As MSForms.ListBox
    Private lblPrm               As MSForms.Label
    Private ROW_NUMBER           As Long

    '=======================================================
    '[取消]ボタン
    Private Sub btnCancel_Click()
    '=======================================================
        ROW_NUMBER = 0
        Unload Me
    End Sub

    '=======================================================
    '[上書き]ボタン
    Private Sub btnSave_Click()
    '=======================================================
        With lstCst
            If Not .ListIndex = -1 Then
                ROW_NUMBER = .List(.ListIndex)
                Unload Me
            End If
        End With
    End Sub

    '=======================================================
    'フォームの形を作る
    Private Sub UserForm_Initialize()
    '=======================================================
        Set lblPrm = Controls.Add("forms.Label.1", , True)
        With lblPrm
            .Top = 10
            .Left = 10
            .Height = 20
            .Width = 340
            .Caption = "下記の方が重複しています。 どちらに上書きしますか?"
        End With

        Set btnSave = Controls.Add("forms.CommandButton.1", , True)
        With btnSave
            .Top = lblPrm.Top + 10
            .Left = 10
            .Width = 50
            .Height = 20
            .Caption = "上書き"
        End With

        Set btnCancel = Controls.Add("forms.CommandButton.1", , True)
        With btnCancel
            .Top = lblPrm.Top + 10
            .Left = btnSave.Left * 2 + btnSave.Width
            .Width = 50
            .Height = 20
            .Caption = "取消"
        End With

        Set lstCst = Controls.Add("forms.ListBox.1", , True)
        With lstCst
            .Top = 50
            .Left = 10
            .Height = 340
            .ColumnCount = MaxCol
            '★必要な列情報の幅を指定してください。
            ' 1列目は行番号を取り込むので、0でもかまいません
            ' 列幅に合わせて、Widthも変更してください
            .ColumnWidths = "0;20;20;20;20;20;20;20;20;20;20;20;20;20;20;20;20;20"
            .Width = 340
        End With

        With Me
            .Width = lstCst.Left * 2 + lstCst.Width
            .Height = lstCst.Top + lstCst.Height
        End With
    End Sub

    '=======================================================
    '元のフォームから呼び出す関数
    Public Function DataView(ByVal Customer As String) As Long
    '=======================================================
        Dim nF    As Range
        Dim fF    As Range
        Dim CData
        Dim c     As Long
        Dim r     As Long
        ReDim CData(1 To MaxCol + lstVal, 1 To 1)
        r = 0
        ROW_NUMBER = 0
        With Range("B:B")
            Set fF = .Find(what:=Customer, after:=Range("B1"), lookat:=xlWhole)
            If Not fF Is Nothing Then
                r = 1
                Set nF = fF
                Do
                    ReDim Preserve CData(1 To MaxCol + lstVal, 1 To r)
                    For c = 1 To MaxCol + lstVal
                        If c <= lstVal Then
                            CData(c, r) = nF.Row
                        Else
                            CData(c, r) = Cells(nF.Row, c - lstVal).Value
                        End If
                    Next c
                    Set nF = .FindNext(nF)
                    If nF Is Nothing Then Exit Do
                    If nF.Address = fF.Address Then Exit Do
                    r = r + 1
                Loop
                lstCst.List = Application.Transpose(CData)
            End If
        End With
        If r > 0 Then
            Me.Show vbModal
        End If
        DataView = ROW_NUMBER
    End Function

 既存のコードを以下のように変更してください。
    Option Explicit
    Private Sub CommandButton登録_Click()
        Dim ACR As Long
        Dim exiWB As String
        Dim A As Workbook
        Dim ans
        Set A = ThisWorkbook
        exiWB = ThisWorkbook.Name
        Windows(exiWB).Activate
        Worksheets("Sheet2").Activate
        ans = MsgBox("顧客情報を登録しますか?", _
        vbOKCancel + vbExclamation, "登録確認")
        If ans = vbCancel Then Exit Sub
        If ans = vbOK Then
            If Not TextBox氏名.Value = Empty Then
                If Not TextBox氏名 Is Nothing Then
                    '★変更箇所
                    'Range("Sheet2!a65536").End(xlUp).Offset(1).Select
                    ACR = UserForm2.DataView(氏名.Value)
                    If ACR = 0 Then
                        If MsgBox("新規登録しますか?", vbYesNo) = vbYes Then
                            ACR = Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1).Row
                        End If
                    End If
                    If ACR > 0 Then
                        Cells(ACR, 1).Value = コードNo.Value
                        Cells(ACR, 2).Value = 氏名.Value
                        Cells(ACR, 3).Value = フリガナ.Value
                        Cells(ACR, 4).Value = 営業
                        Cells(ACR, 5).Value = ID
                        Cells(ACR, 6).Value = 契約日
                        Cells(ACR, 7).Value = 引渡日
                        Cells(ACR, 8).Value = 〒
                        Cells(ACR, 9).Value = 住所1
                        Cells(ACR, 10).Value = 住所2
                        Cells(ACR, 11).Value = TEL
                        Cells(ACR, 12).Value = 勤務先
                        Cells(ACR, 13).Value = 勤務先TEL
                        Cells(ACR, 14).Value = 連名1
                        Cells(ACR, 15).Value = 連名2
                        Cells(ACR, 16).Value = 連名3
                        Cells(ACR, 17).Value = TextBox備考
                        TextBoxコードNo.SetFocus
                        ActiveCell.Offset(0).Activate
                        MsgBox "登録しました。"
                        CommandButton登録.Enabled = False
                        CommandButton更新.Enabled = True
                        CommandButton新規.Enabled = True
                        CommandButton削除.Enabled = True
                    End If
                Else
                    MsgBox "氏名が登録されていません。"
                    氏名.Value = Empty
                    CommandButton登録.Enabled = True
                    CommandButton更新.Enabled = False
                    CommandButton新規.Enabled = True
                    CommandButton削除.Enabled = False
                End If
            Else
                MsgBox "登録する氏名を入力して下さい。"
                CommandButton登録.Enabled = True
                CommandButton更新.Enabled = False
                CommandButton新規.Enabled = True
                CommandButton削除.Enabled = False
            End If
        End If
        Windows(exiWB).Activate
        Worksheets("Sheet1").Select
    End Sub

 ※重複していなかったときの処理を追加
  15:39
 ※デバッグ用のゴミついてた・・・ 15:47

(稲葉) 2015/04/22(水) 15:36


稲葉さん

コメント及びコードありがとうございます。
稲葉さんより、
>別のユーザーフォームにリストで表示させて、上書きなら既存のコードの
>変数ACR に行番号を渡す、なんて方法はどうですか??
とのコメントを頂き、少し悩んでおりました。
ご説明不足で大変申し訳ないのですが、
理由として、顧客データのフォームに紐付いて別にフォームが4つあるからです。
入力項目がかなりの数ある為、メインの顧客データのフォームに入力する情報は、
Sheet2に集約し、Sheet2のセレクトしているセル(行)を基準をSheet3〜6に連動して
入力するように制御しております。
ですので、メッセージボックスには、Sheet2〜6の情報全てを表示する必要があり、
それは難しいかなと考えておりました。

しかし、
お教え頂いたコードを試してみたのですが、
私的に、かなり画期的で感動しており、是が非でも使用したいと考えておりますので、
ちょっと上手い使用方法を検討したいと思います。

(ルイージ) 2015/04/22(水) 17:51


 確かに、まず名前を入力して重複チェックしたほうがいいですね。
 同姓同名の可能性はなくはないですが低いので。

 シートが複数ある場合も稲葉さんが提示されているFind、FindNext
 を使っていけます。

[[20100729173059]] 『複数シート間の検索』(samikou2003)
(カリーニン) 2015/04/22(水) 21:25


おはようございます。
昨日から、稲葉さんにお教え頂いたコードを色々いじっていますが、
なにぶん、まだまだ初心者の為、紐解くのにかなりの時間が必要そうです。
コンボボタンやリストボックスをコードで作成できることもしりませんでしたので、
リストボックスのサイズ変更も苦戦してる次第です。

カリーニンさんが仰る通り、
最初から100%を求めるのでは無く、まず名前の重複チェックから行い、
そこから複数シート間の検索まで発展させて行こうと思います。

お二方共、親切&丁寧にお教え頂き心よりお礼申し上げます。ありがとうございました。
しばらく自身で奮闘しますので、壁にぶち当たったら再度ご質問させて頂きます。
ありがとうございました!
(ルイージ) 2015/04/23(木) 08:54


 >リストボックスのサイズ変更も苦戦してる次第です。 
 ここは、名前だけ継承して、編集画面で調整してもよいと思います。
 具体的には、
 コマンドボタンを二つとリストボックスひとつを配置する(CommandButton1とCommandButton2とListBox1)
 名前を変更する(btnCancelとbtnSaveとlstCst)
 リストボックスのColumnCountとColumnWidthプロパティで必要な列数分指定する
 これだけで動きます。
 (もちろん、コードの部分は消すか、コメントアウトしてください。

 動的にプロパティを変更するわけではないので、やりやすいほうで調整してみてください。
(稲葉) 2015/04/23(木) 10:41

稲葉さん

コメントありがとうございます。

Set lstCst = Controls.Add("forms.ListBox.1", , True)

        With lstCst
            .Top = 50
            .Left = 10
            .Height = 340
            .ColumnCount = MaxCol
            '★必要な列情報の幅を指定してください。
            ' 1列目は行番号を取り込むので、0でもかまいません
            ' 列幅に合わせて、Widthも変更してください
            .ColumnWidths = "0;20;20;20;20;20;20;20;20;20;20;20;20;20;20;20;20;20"
            .Width = 340
        End With

で変更するんだろうなと数値変えてたんですけど、
フォームサイズが変更してしまうので、困ってました。

仰る様に、自分のレベルに合わせて、フォーム上に配置して行ってみます!
(ルイージ) 2015/04/23(木) 10:57


 横から失礼します。

 稲葉さんから提示のコードで進めていってもらい、早晩、解決ということになるかと思いますので、以下はお暇なときに。

 基本、現行の構えで要件を満たそうと、とりあえず、現行コードをコピペし、眺めてみました。
 コードの細かなところでは、このコードは不要とか、ここは、こう記述すべきとか、いくつかありますが
 それらは、さておいて、

            If Not TextBox氏名.Value = Empty Then
                If Not TextBox氏名 Is Nothing Then

 ここが非常に気になっています。

 TextBox氏名は必須項目で、値がなかったらエラーというのはわかりますが、その次の
 If Not TextBox氏名 Is Nothing Then
 これは、氏名がシートに登録されていればエラーにしたい部分なのかなと想像します。
 (ボタン機能の、登録と新規がどう違うのかがわからないのですが想像)

 で、この TextBox氏名 というのは、ユーザーフォーム上のTextBoxですよね。
 (そのほかに、コード内で、氏名.Value が登場しているのも気にはなりますが)
 これが Nothing かどうか? Nothing ということは、ありえませんし、仮に Nothing なら その上の
 If Not TextBox氏名.Value = Empty Then で、実行時エラーになります。
 ということは、MsgBox "氏名が登録されていません。" というところへは、未来永劫、とんでいかないということになります。

 このあたりはいかがなんでしょうね?

(β) 2015/04/23(木) 11:39


βさん

コメントありがとうございます。
ご質問の件、
新規ボタンと登録ボタンの違いですが、
新規ボタンをを押すと、
  1.フォーム上に表示しているテキストボックス等の表示をクリア
  2.Sheet2のA列最終行のコードNo.を読み取り+1した値を、
   フォーム上のテキストボックス(コードNo.)に表示
  3.新規ボタン/更新ボタン/削除ボタンをFalse
を行います。
登録ボタンは、テキストボックスに表示した情報をSheet2の最終行に登録です。

TextBox氏名.Valueと、氏名.Valueは同じになります。
ちょっとテキストボックスの名前を変えようとしていた途中でしたので、
アップしたコードには、名残が残っておりました。(紛らわしくてすみません)

>これが Nothing かどうか? Nothing ということは、ありえませんし、仮に Nothing なら その上の
>f Not TextBox氏名.Value = Empty Then で、実行時エラーになります。
>ということは、MsgBox "氏名が登録されていません。" というところへは、
>未来永劫、とんでいかないということになります。
この件については、普通に動作してます。
氏名が入力されていない状態で、登録ボタンを押すと、
メッセージボックスで「顧客情報を登録しますか」
と聞かれ、OKを押すと、
メッセージボックスで「氏名が登録されていません」
となり、フォーム画面に戻ります。

  
(ルイージ) 2015/04/23(木) 15:19


 To (ルイージ)さん

 まず、コメントしたように、私が眺めているコードは当初アップされたコードです。
 (稲葉さんのコードでも基本、ここは、手を入れておられないので、同じ状況のはずです)

 >この件については、普通に動作してます。 
 >氏名が入力されていない状態で、登録ボタンを押すと、 
 >メッセージボックスで「顧客情報を登録しますか」 
 >と聞かれ、OKを押すと、 
 >メッセージボックスで「氏名が登録されていません」 

 そうじゃないはずです。この状態で表示されるメッセージは
 「登録する氏名を入力して下さい。」でしょ?

 そちらのコードの関連部分を【インデントを付けて】抜粋すると以下ですね。

    If ans = vbOK Then
        If Not TextBox氏名.Value = Empty Then		'★氏名が空白の場合
            If Not TextBox氏名 Is Nothing Then
                    '省略
                MsgBox "登録しました。"
                    '省略
            Else
                MsgBox "氏名が登録されていません。"     '★βが指摘してるのはここ		
                    '省略
            End If
        Else
            MsgBox "登録する氏名を入力して下さい。"    '★氏名が空白の場合のとび先
                    '省略
        End If
    End If

 ご覧になればわかると思いますが。
 「氏名が登録されていません」というメッセージは絶対にでないはずですよ。

(β) 2015/04/23(木) 16:38


βさん

すみません!良くみてませんでした!
仰る通り、「登録した氏名を入力して下さい」
の間違いでした。
動作上問題無かったので、全く気にしていませんでした。

「氏名が登録されていません」については、
フォーム上に、検索用のテキストボックス&コマンドボタンがありまして、
そのコードを登録ボタン用にコピーして変更した際の名残だと思います。

(ルイージ) 2015/04/23(木) 16:50


 ご理解いただけて幸甚。

 あとは、稲葉さんの導きで、解決に向かっていってください。

 ということで、以下は、混乱させるのが目的ではなく、現行のコードで、これはいらないよなぁ、
 ここは、こう書いたほうがいいよなぁと感じたことを盛り込んだ、現行コードベースに、重複メッセージを
 メッセージボックスで表示する部分を追加したものです。

 お暇な折に眺めて、さらに時間があれば試してみてください。

 Private Sub CommandButton登録_Click()
    Dim ACR As Long
    Dim A As Workbook
    Dim z As Variant

    Set A = ThisWorkbook
    A.Activate
    Worksheets("Sheet2").Activate
    If MsgBox("顧客情報を登録しますか?", _
            vbOKCancel + vbExclamation, "登録確認") = vbCancel Then Exit Sub
    If Not TextBox氏名.Value = Empty Then
        z = Application.Match(TextBox氏名.Value, Range("A1").CurrentRegion.Columns("B"), 0)
        If IsNumeric(z) Then
            If MsgBox("同じ氏名が存在します。登録しますか?" & vbLf & _
                Join(WorksheetFunction.Transpose(WorksheetFunction.Transpose(Range("A1:Q1").Offset(z - 1))), vbLf), _
                vbYesNo + vbInformation) = vbNo Then Exit Sub
        End If
        ACR = Range("A" & Rows.Count).End(xlUp).Offset(1).Row
        Cells(ACR, 1).Value = TextBoxコードNo.Value
        Cells(ACR, 2).Value = TextBox氏名.Value
        Cells(ACR, 3).Value = TextBoxフリガナ.Value
            '
            '省略
            '
        Cells(ACR, 17).Value = TextBox備考
        TextBoxコードNo.SetFocus
        MsgBox "登録しました。"
        CommandButton登録.Enabled = False
        CommandButton更新.Enabled = True
        CommandButton新規.Enabled = True
        CommandButton削除.Enabled = True
    Else
        MsgBox "登録する氏名を入力して下さい。"
        CommandButton登録.Enabled = True
        CommandButton更新.Enabled = False
        CommandButton新規.Enabled = True
        CommandButton削除.Enabled = False
    End If

    Application.Goto A.Worksheets("Sheet1").Range("A1")

 End Sub

(β) 2015/04/23(木) 17:19


 追加で(おせっかいですねぇβも)

 コードNo の必須チェックをしていませんよね。
 ということは、可能性としてコードNo(シートではA列)が空白ということもありうるわけですね。
 一方、セット行の取得を A列で行っていますね?
 そうすると、実際にデータが存在する行に書き込むリスクが発生します。

 最終行を 氏名があるB列で判定するか、コードNoも必須チェックを掛けるか、いずれかが必要でしょうね。

(β) 2015/04/23(木) 17:31


βさん

いろいろありがとうございます。
まだ試せて無いですが、近々に試してご報告せさて頂きます。

コードNoは、新規ボタンを押すと必ず入力される様になっており、
使用者が、フォーム上で消去も出来ないようにしてますので大丈夫です。
ありがとうございます!!

(ルイージ) 2015/04/23(木) 18:03


βさん

早速試してみました!
とても素晴らしいです!!ありがとうございます!!

最終形は、稲葉さんのをベースに作りたいと思っておりますが、
かなりの時間が必要となりそうなので、ご好意に甘え当面は、βさんのを使用させて頂きます。
お陰様で、悩まされていたデータ重複問題から開放されました。

最後にもう一点甘えさせて頂きたいのですが、
氏名にスペースがあった場合と無い場合で、判別できないでしょうか?
全く同じでしたら、確認用のメッセージボックスが出たのですが、
苗字と名前の間にスペースを付けたら、そのまま登録されましたので。。。
(ルイージ) 2015/04/23(木) 18:48


 たとえば、シートに登録する氏名には絶対にスペースが入らない、仮にTextBox氏名で間にスペースが入って入力されても
 シートには、スペースを削除して転記する。
 こういう仕様であれば簡単ですが、スペースはスペースで尊重して、でもチェックだけはスペースを除いてということだと
 できないことはないですけど、ちょっと細工が要ります。

(β) 2015/04/23(木) 19:19


 「ちょっと細工」版です。

 チェックは、他のところでも使う可能性があるので、共通プロシジャ IsNameExists として別建て。
 シートの氏名、テキストボックスの氏名、それぞれチェック用にスペースを除き、もし存在すれば
 結果として行番号を、存在しなければ 0 を返します。

 Private Sub CommandButton登録_Click()
    Dim ACR As Long
    Dim A As Workbook
    Dim z As Long

    Set A = ThisWorkbook
    A.Activate
    Worksheets("Sheet2").Activate
    If MsgBox("顧客情報を登録しますか?", _
            vbOKCancel + vbExclamation, "登録確認") = vbCancel Then Exit Sub
    If Not TextBox氏名.Value = Empty Then
        z = IsNameExists(TextBox氏名)
        If z > 0 Then
            If MsgBox("同じ氏名が存在します。登録しますか?" & vbLf & _
                Join(WorksheetFunction.Transpose(WorksheetFunction.Transpose(Range("A1:Q1").Offset(z - 1))), vbLf), _
                vbYesNo + vbInformation) = vbNo Then Exit Sub
        End If
        ACR = Range("A" & Rows.Count).End(xlUp).Offset(1).Row
        Cells(ACR, 1).Value = TextBoxコードNo.Value
        Cells(ACR, 2).Value = TextBox氏名.Value
        Cells(ACR, 3).Value = TextBoxフリガナ.Value
            '
            '省略
            '
        Cells(ACR, 17).Value = TextBox備考
        TextBoxコードNo.SetFocus
        MsgBox "登録しました。"
        CommandButton登録.Enabled = False
        CommandButton更新.Enabled = True
        CommandButton新規.Enabled = True
        CommandButton削除.Enabled = True
    Else
        MsgBox "登録する氏名を入力して下さい。"
        CommandButton登録.Enabled = True
        CommandButton更新.Enabled = False
        CommandButton新規.Enabled = True
        CommandButton削除.Enabled = False
    End If

    Application.Goto A.Worksheets("Sheet1").Range("A1")

 End Sub

 Private Function IsNameExists(nm As String) As Long
    Dim w As Variant
    Dim s As String
    Dim z As String
    Dim nmx As String
    Dim n As Long
    s = vbTab & Join(WorksheetFunction.Transpose(Range("B2", Range("B" & Rows.Count).End(xlUp)).Value), vbTab) & vbTab
    s = Replace(Replace(s, " ", ""), " ", "")
    nmx = Replace(Replace(nm, " ", ""), " ", "")
    n = InStr(s, vbTab & nmx & vbTab)
    If n > 0 Then
        z = Replace(Left(s, n), vbTab, "")
        IsNameExists = n - Len(z) + 1
    End If
 End Function

(β) 2015/04/23(木) 20:07


βさん

おはよございます。
すみません、ちょっと私の説明不足で意図が伝わってない感じがします。
仮に「山田太郎」と登録されているとして、
新規で「山田 太郎」と登録しようとした場合、
苗字と名前の間にスペースがある為、重複確認用のメッセージが出ず登録されます。
スペースの有無を判別して、
「山田太郎」と「山田 太郎」を同一と判定し重複確認用メッセージを出したいです。。。

(ルイージ) 2015/04/24(金) 08:16


 えっ???

 そうしているつもりなんですが?(汗)
 もうしばらくしたら外出しますので、帰宅後 検証します。

 今、ちょこっと検証。
 シート B列には 山田太郎。入力を 山田 太郎(全角スペース)、山田 太郎(半角スペース)。
 いずれも、重複メッセージが出ますが?

 追伸

 コードを書いていて気になったんですが、SHeet2をアクティブにして、コードはシート修飾せず
 アクティブシートがSheet2であるという前提になっていますよね。
 もし、実行時にSheet2がアクティブになっていなかったら、おっしゃるようになります。
 いずれにしても、このような状況依存のコードは好ましくないと思います。

(β) 2015/04/24(金) 08:35


 もうそろそ出かけます。

 もしかして、SHeet2の名簿ですけど、1行目からデータですか?
 で、山田太郎は1行目にあります?

 もし1行目からデータであれば

 IsNameExists 内の 

 s = vbTab & Join(WorksheetFunction.Transpose(Range("B2", Range("B" & Rows.Count).End(xlUp)).Value), vbTab) & vbTab

 これを

 s = vbTab & Join(WorksheetFunction.Transpose(Range("B1", Range("B" & Rows.Count).End(xlUp)).Value), vbTab) & vbTab

 にしてください。

(β) 2015/04/24(金) 08:52


βさん

重ね重ねすみません!
また私の早合点だったみたいです。。。
本当にすみません。

データは3行目からです。
s = vbTab & Join(WorksheetFunction.Transpose(Range("B3", Range("B" & Rows.Count).End(xlUp)).Value), vbTab) & vbTab
にして、使用させて頂きます。

(ルイージ) 2015/04/24(金) 08:59


う〜ん。。。

やはり重複メッセージは出ないです。。。
何故でしょうか。。。

>コードを書いていて気になったんですが、SHeet2をアクティブにして、コードはシート修飾せず
>アクティブシートがSheet2であるという前提になっていますよね。
>もし、実行時にSheet2がアクティブになっていなかったら、おっしゃるようになります。
>いずれにしても、このような状況依存のコードは好ましくないと思います。
もともとはSheet2しか無く、後にSheetも増えて行きましたので。。。
全くの素人が、マクロの記憶とネット検索で3ヵ月かけデータベースを作成したので、
コードの好む好ましくないの判断も良く分からないんです。。。
(ルイージ) 2015/04/24(金) 09:40


さらに、う〜ん。。。
な状態です。

また試してみたら、ちゃんと重複メッセージがでましたが、
重複メッセージの内容が、すでに入力されて氏名の一つ上の氏名になってしまいます。

入力済
  1 山田花子
  2 山田太郎

新規入力
  3 山田 太郎

重複メッセージ
  同じ氏名が存在します。登録しますか?
   1
   山田花子

さっきまでは、
スペース有だと重複メッセージは出ませんでしたし良く分かりません。
(ルイージ) 2015/04/24(金) 10:40


何度も何度も申し訳ございません。

If MsgBox("同じ氏名が存在します。登録しますか?" & vbLf & _

                Join(WorksheetFunction.Transpose(WorksheetFunction.Transpose(Range("A1:Q1").Offset(z - 1))), vbLf), _
                vbYesNo + vbInformation) = vbNo Then Exit Sub
        End If
を
If MsgBox("同じ氏名が存在します。登録しますか?" & vbLf & _
                Join(WorksheetFunction.Transpose(WorksheetFunction.Transpose(Range("A1:Q1").Offset(z))), vbLf), _
                vbYesNo + vbInformation) = vbNo Then Exit Sub
        End If
に変更すると、
すでに入力された氏名を表示してくれました。
スペース判別のエラーも再現しなくなりましたので、解決とさせて頂きます。
ありがとうございました!!
(ルイージ) 2015/04/24(金) 11:10

 >スペース判別のエラーも再現しなくなりましたので、解決とさせて頂きます。

 もちろん、使うのは ルイージさんなので、それでいいということであれば、それでいいのですが
 βとしては、この IsNameExists は 登録前に氏名を与えて重複チェックをする共通プロシジャとして位置づけたら
 いいのではと思っています。別のコマンドボタンでも使うかもしれないし、別のフォームでも使うかもしれない。
 (別のフォームで使う場合は、このプロシジャの Private をとりさって、標準モジュールに配置することになりますが)

 なので、あくまで、戻り値は、当該顧客の Sheet2上の行番号にしておきたいですねぇ。

 ですから、

 Join(WorksheetFunction.Transpose(WorksheetFunction.Transpose(Range("A1:Q1").Offset(z - 1))), vbLf), _

 ここは、このままにしておいて IsNameExists 内の IsNameExists = n - Len(z) + 1 を IsNameExists = n - Len(z) + 4
 こうして使ってもらえればうれしいなぁ。

(β) 2015/04/24(金) 11:40


IsNameExists 内の IsNameExists = n - Len(z) + 1 を IsNameExists = n - Len(z) + 4 にして使うと、重複メッセージに、登録してある2行下の行の内容を表示します。

Sheet2に、
A  B
1 山田
2 田中
3 佐藤

山田を登録しようとすると、

  同じ氏名が存在します。登録しますか?
       3 
       佐藤

となります。。。

多分私が、
>あくまで、戻り値は、当該顧客の Sheet2上の行番号にしておきたいですねぇ。
意味を理解できてないせいだと思いますが・・・

  
(ルイージ) 2015/04/24(金) 15:51


 >意味を理解できてないせいだと思いますが・・・ 

 いえいえ、βがおばかだったんです。ごめんなさい。
 こちらでテストしたシートが3行目からじゃなくって・・(ほんとにおバカです)

 IsNameExists = n - Len(z) + 2

 こうしてください。ほんとにごめん。

(β) 2015/04/24(金) 17:05


いえいえ、折角教えて頂いたのに、
私が調べて理解しようとせず、
甘えて聞いてばかりになっているせいです。すみません。。。

ですがお陰様で、
IsNameExists = n - Len(z) + 2
に変更すると上手く動作しました。

お手数お掛けして申し訳ございませんでした。
ありがとうござました!!!
(ルイージ) 2015/04/24(金) 17:30


コメント返信:

[ 一覧(最新更新順) ]


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