Results of 1 - 1 of about 19659 for 20�����������������������... (0.004 sec.)
- [[20150422102657]]
- #score: 2681
- @digest: 995a991ea9e80e96a1f3c8039c6b669e
- @id: 67836
- @mdate: 2015-04-24T08:30:07Z
- @size: 31099
- @type: text/plain
- #keywords: isnameexists (98782), acr (84404), 規. (64660), lstcst (62602), enabled (46959), commandbutton (44060), 新. (41257), ルイ (39961), ドno (31056), 録. (29754), イー (27046), textbox (19167), 名. (18676), 氏名 (17915), 登録 (15321), 除. (14984), 田太 (9902), vbtab (8685), ジボ (7069), ッセ (5064), メッ (5039), 山田 (5033), transpose (4748), 2015 (4668), 重複 (4560), 稲葉 (4503), 顧客 (4499), セー (4473), worksheetfunction (4004), 新規 (3854), スペ (3798), トボ (3613)
- 『重複氏名のお知らせ確認』（ルイージ）
いつもお世話になってます。 エクセルで顧客データの台帳を作成しており、 フォーム上で、データの登録・更新・削除を行っているのですが、 登録時に、氏名の重複確認を行い、重複がある場合、 メッセージボックスで、同じ氏名があることをお知らせしたいです。 同姓同名もありえますので、あくまでお知らせだけしたいと考えております。 具体的には、 登録時に、テキストボックスに入力した氏名から、 (登録ボタンを押した時)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... - https://www.excel.studio-kazu.jp/wiki/kazuwiki/201504/20150422102657.txt - [detail] - similar
PREV
NEXT
Powered by Hyper Estraier 1.4.13, with 97054 documents and 608268 words.
訪問者：