[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『ユーザーフォームで入力したい』（みお）
VBA初心者です
入力作業をダイアログボックスを使って入力したいと思っています。
いきなり長くてすいません。
エクセルでユーザーフォームを使い、２項目の入力を行おうと思っています。
現在の作業は、２本（１，２）のバーコードをバーコードリーダーでそれぞれ読み取って入力しております。
バーコードの内容は
１、商品コード（14桁）Ａ0001215042001
商品コード 詳細 Ａ0001 2 150420 01
（左から）最初の5桁 Ａ0001＝アイテムコード、2＝生産ライン、150420＝製造年月日（yymmdd)、01=シリアルN.o.
２、作業者コード（4桁）1234
※バーコーリーダーの設定は"入力したらTAB"になっております。
作業内容
１、Ａ1にカーソルを合わせ、商品コード（１４桁）を読ませる。
２、Ｂ1にカーソルを合わせ（移動しているので）作業者コード（4桁）を読ませる。
次はＡ2、Ｂ2 次はＡ3、Ｂ3・・・
この作業の繰り返しです。
これらの作業をユーザーフォームを使って行いたいと思いまして、初心者なりに調べましたら同じような例がインターネット上にありましたので
下記のプログラムを活用してできないかと思っております。
※最近コード化されたことで手入力だったので可能だった入力規則の機能ができなくなっていまいました。
いままで→Ａ0001だけ入力 入力規則「=COUNTIF($A$1:$A$100,A1)=1」で対応
コード化→Ａ0001215042001 関数にしてLEFT(A1,5) でＡ0001を抽出して入力規則をつけてもメッセージがでなくなった。
このようなことでユーザーフォームで効率化と間違い入力をなくせればと思っております。
フォームは、テキストボックスが３つ、コマンドボタン１つです。
コードは以下のようになっておりました。（実際に使ってみたら少し変更すれば出来そうでした。私が使おうと思っているのは2項目なのでTXT_DEPTを
消して使おうと思っています。）
●sheet1
Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim GYO As Long
' 商品コード列のみを対象とする
If Target.Column <> 1 Then Exit Sub
GYO = Target.Row
' 登録処理を呼び出す(引数は選択行)
Call TOUROKU(GYO)
End Sub
●標準モジュール
Option Explicit
Public g_swOK As Byte ' ﾌｫｰﾑで登録が押されたかを判定するｽｲｯﾁ
' ユーザー情報の登録処理
Public Sub TOUROKU(GYO As Long)
' 現在選択行を取得
GYO = ActiveCell.Row
' ユーザー情報の登録のフォームを表示
Load FRM_USER
With FRM_USER
If ((GYO = 1) Or (Cells(GYO, 1).Value = "")) Then
' 見出しか未登録行の場合は新規登録と判断
GYO = 0
.TXT_NAME.Text = ""
.TXT_CODE.Text = ""
.TXT_DEPT.Text = ""
Else
' 既存行の場合は修正と判断
.TXT_NAME.Text = Cells(GYO, 1).Value ' 商品コード
.TXT_CODE.Text = Cells(GYO, 2).Value ' 作業者コード
.TXT_DEPT.Text = Cells(GYO, 3).Value ' 部署
End If
' ﾌｫｰﾑを表示
g_swOK = 0
.Show
' 登録ﾎﾞﾀﾝが押されていない場合は以降の処理はしない
If g_swOK <> 1 Then GoTo TOUROKU_EXIT
' 新規登録の場合は未登録行を探す
If GYO = 0 Then
GYO = 2
' 商品コード列未登録を判定
Do While Cells(GYO, 1).Value <> ""
GYO = GYO + 1
Loop
End If
' ｼｰﾄ上に登録
ActiveSheet.Unprotect
Cells(GYO, 1).Value = Trim$(.TXT_NAME.Text) ' 商品コード
Cells(GYO, 2).Value = Trim$(.TXT_CODE.Text) ' 作業者コード
Cells(GYO, 3).Value = Trim$(.TXT_DEPT.Text) ' 部署
ActiveSheet.Protect
End With
' ｵﾌﾞｼﾞｪｸﾄ廃棄のための行ﾗﾍﾞﾙ
TOUROKU_EXIT:
' FRM_USERをｱﾝﾛｰﾄﾞしｵﾌﾞｼﾞｪｸﾄを解放
Unload FRM_USER
Set FRM_USER = Nothing
End Sub
●フォーム
Option Explicit
' ｢登録｣ボタンのクリックイベント
Private Sub CMD_OK_Click()
Dim strMSG As String
' 入力内容のチェック
If Trim$(TXT_NAME.Text) = "" Then
strMSG = "商品コードが入力されていません。"
ElseIf Trim$(TXT_CODE.Text) = "" Then
strMSG = "作業者コードが入力されていません。"
ElseIf Trim$(TXT_DEPT.Text) = "" Then
strMSG = "部署が入力されていません。"
ElseIf IsNumeric(Trim$(TXT_CODE.Text)) <> True Then
strMSG = "作業者コードが数字ではありません。"
ElseIf Len(Trim$(TXT_CODE.Text)) <> 4 Then
strMSG = "作業者コードは4桁で入力して下さい。"
End If
' チェックでエラーの場合は登録しない
If strMSG <> "" Then
MsgBox strMSG, vbExclamation ' ｴﾗｰ表示
Exit Sub
End If
' チェックOKはフォームから戻る
g_swOK = 1 ' OKｽｲｯﾁをｾｯﾄ
Me.Hide ' ﾌｫｰﾑを消去
End Sub
○要望は、以下の2つの入力に対しMsgBoxを出して入力を禁止したいのですがどうすればよいのでしょうか？
1、重複入力の禁止。同じ商品コード（例Ａ0001215042001）が2回入力されたらMsg"重複しています"
2、同じアイテムコード「Ａ0001」以外の入力禁止。違うアイテムコード（例「Ａ0002」215042001）が入力されたらMsg"アイテムコードが違います"
※Ａ0001以降の数字 215042001は変化しても可
上記1について「重複入力の禁止」
調べたコード
Option Explicit
Private Sub worksheet_change(ByVal target As Range)
If target.Count <> 1 Then Exit Sub
If target.Row > 10 Then Exit Sub
If target.Column <> 1 Then Exit Sub
If Application.WorksheetFunction.CountIf(Range("a1:a10"), target.Value) > 1 Then
MsgBox "重複しています"
target.Value = ""
End If
End Sub
単独でプログラムを動かすことはできましたが、●sheet1のコードにどうつなげればいいのかわかりませんでした。
上記2については、わかりませんでした。
どなたか少しずつでもよいのでご教示願います。
＜ 使用 Excel：Excel2010、使用 OS：Windows7 ＞
おはようございます。
要件の確認です。
「A0001」「2」「12345678」 この１４桁で重複エラーは理解しました。
で、２．のアイテムコードのチェックですが
>同じアイテムコード「A0001」以外の入力禁止。
ここがよくわかりません。 具体例をいくつか（ＯＫのもの、ＮＧのもの）をあげていただけませんか？
あと、コードの構成としては
・シートモジュールの SelectionChangeで呼び出し ・標準モジュールで、ある程度の処理をして ・ユーザーフォームである程度の処理をして ・抜けてきてから、また標準モジュールで更新処理をして
という構えですね。
さらに、今度、Changeイベント処理を追加すれば、それも絡み合うわけで、 あちらこちらに処理が分散。開発も大変でしょうが、維持保守フェーズで苦労しそうです。
通常は、SelectionChangeで呼び出し、処理はユーザーフォームモジュール一本で対応させるところでしょうね。
（β） 2015/04/28(火) 06:01
とりあえず、↑で申し上げた構成を一本化したものです。 これをベースに要件追加をしていかれてはいかがでしょうか。
・標準モジュールのコードは不要 ・シートモジュール
Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
' 商品コード列のみを対象とする
If Target.Column = 1 Then FRM_USER.Show
End Sub
・ユーザーフォームモジュール
Option Explicit
Dim GYO As Long
Private Sub UserForm_Initialize()
' 現在選択行を取得
' 見出しか未登録行の場合は新規登録と判断
If ActiveCell.Row = 1 Or ActiveCell.Value = "" Then
GYO = Range("A" & Rows.Count).End(xlUp).Offset(1).Row
TXT_NAME.Text = ""
TXT_CODE.Text = ""
TXT_DEPT.Text = ""
Else
' 既存行の場合は修正と判断
GYO = ActiveCell.Row
TXT_NAME.Text = Cells(GYO, 1).Value ' 商品コード
TXT_CODE.Text = Cells(GYO, 2).Value ' 作業者コード
TXT_DEPT.Text = Cells(GYO, 3).Value ' 部署
End If
End Sub
' ｢登録｣ボタンのクリックイベント Private Sub CMD_OK_Click()
Dim strMSG As String
' 入力内容のチェック
If Trim$(TXT_NAME.Text) = "" Then
strMSG = "商品コードが入力されていません。"
ElseIf Trim$(TXT_CODE.Text) = "" Then
strMSG = "作業者コードが入力されていません。"
ElseIf Trim$(TXT_DEPT.Text) = "" Then
strMSG = "部署が入力されていません。"
ElseIf IsNumeric(Trim$(TXT_CODE.Text)) <> True Then
strMSG = "作業者コードが数字ではありません。"
ElseIf Len(Trim$(TXT_CODE.Text)) <> 4 Then
strMSG = "作業者コードは4桁で入力して下さい。"
End If
' チェックでエラーの場合は登録しない
If strMSG <> "" Then
MsgBox strMSG, vbExclamation ' ｴﾗｰ表示
Exit Sub
End If
' チェックOKで更新処理
ActiveSheet.Unprotect
Cells(GYO, 1).Value = Trim$(TXT_NAME.Text) ' 商品コード
Cells(GYO, 2).Value = Trim$(TXT_CODE.Text) ' 作業者コード
Cells(GYO, 3).Value = Trim$(TXT_DEPT.Text) ' 部署
ActiveSheet.Protect
Me.Hide ' ﾌｫｰﾑを非表示
End Sub
（β） 2015/04/28(火) 07:03
追加で
１．Range("a1:a10") や If target.Row > 10 が登場しますが、１０行以上の入力はないということですか？
２．「調べたコード・・・単独でプログラムを動かすことはできましたが・・・」
ほんとですか？ 不具合は発生しませんでしたか？
（β） 2015/04/28(火) 08:54
＞フォームは、テキストボックスが３つ、コマンドボタン１つです。
バーコードを使って入力するのであれば、部品としては ・テキストボックス（作業者コード入力用） ・テキストボックス（商品コード入力用） ・コマンドボタン（データ登録・更新用） 必要ならば ・ラベル（アイテムコード表示用） ・ラベル（生産ライン表示用） ・ラベル（製造年月日表示用） ・ラベル（シリアルNo.表示用）
みたいな感じで、私なら作りそうです。 １）テキストボックスにバーコードリーダーで入力 ２）ボタンクリックで登録する という作業です。
みおさんがイメージしている操作と違いますか？
（マナ） 2015/04/28(火) 21:57
（β）さまへのご返答
同じアイテムコード「A0001」以外の入力禁止。
「ここがよくわかりません。」・・・に対してですが、 説明不足で申し訳ありません。 例 1号機から10号機まで10本の生産ラインが並んでいます。 1号機はＡ0001のアイテムしか作りません。2号機はＡ0002だけ、３号機はＡ0003だけ、4号・・・ ですので1号機にＡ0002のアイテムが入っては困ります。ですが、たまにまちがってしまいます。後で気づいて戻します（ひと苦労） で、こんな感じでできればと 1号機 Ａ000 1 215042101・・・ＯＫ Ａ000 1 215042102・・・ＯＫ Ａ000 2 215042103・・・ＮＧ "アイテムコードが違います"
例えばセルＤ1にＡ0001と入力しておいて、商品コードを読ませたときに、Ｄ1と商品コードの最初の５ケタが＝でなければＮＧのような感じでできればと
思います。
「追加で」に対してですが、
１．Range("a1:a10") や If target.Row > 10 が登場しますが、１０行以上の入力はないということですか？
回答 （"A1:A100) If target.Row > 100 です。（修正もれスイマセン）
２．「調べたコード・・・単独でプログラムを動かすことはできましたが・・・」
ほんとですか？ 不具合は発生しませんでしたか？
回答
「調べたコード 」下記のコードをまっさらなWorkbookを開きsheet1モジュールに貼り付けでＡ1に1と入力、Ａ2に1と入力し、
"重複しています"のメッセージボックスが出ました。、
Option Explicit
Private Sub worksheet_change(ByVal target As Range)
If target.Count <> 1 Then Exit Sub
If target.Row > 100 Then Exit Sub
If target.Column <> 1 Then Exit Sub
If Application.WorksheetFunction.CountIf(Range("a1:a100"), target.Value) > 1 Then
MsgBox "重複しています"
target.Value = ""
で、「不具合は・・・？」発生しました。
このコードをsheetモジュールの最後（前回あげたコードの後）にそのまま貼り付けたらもちろんコンパイルエラーとなりました
（開き直って申し訳ありません。）
そのうえで２つの条件「重複しない」と「Ａ0001だけ」に対し、条件を満たさない場合、メッセージボックスが出てで入力不可にしたいと
思っております。
（β）さまのコード、だいぶすっきりしていますが、おなじことができました。ありがとうございます。
同じ動きをする違う書き方のコードが見られることで初心者の私でもほんの一部分ではありますが、なんとなく使い方を勉強できる感じがしました
一つだけ変わった結果になったところがありました。フォームのテキストボックス内に前回入力した情報が残ってしまいます。
恐縮ですが前回の情報を消すことは可能でしょうか？
（マナ）さまへのご返答
みおさんがイメージしている操作と違いますか？ についてですが
全くその通りです
ラベルについてですが、ラベルについては表示をすること以外の機能を私がわからなかったので今回は不要にしました。ただ今回のマクロが出来れば同じようなラインがまだありますので、そこで今後展開したいと思います。
１）テキストボックスにバーコードリーダーで入力
２）ボタンクリックで登録する
追加で
3）重複入力を禁止する
4）14桁のうち最初の5桁（アイテムコード）だけ、同じコードのみ入力、違うアイテムコードの入力を禁止する
1）～4）までが出来ればかなりミスや効率が改善されます。何卒よろしくお願いします。
１．コード体系は重要ですから再確認です。
最初の説明では
>（左から）最初の5桁 Ａ0001＝アイテムコード、2＝生産ライン、150420＝製造年月日（yymmdd)、01=シリアルN.o
今回は
>Ａ000 1 215042101・・・ＯＫ
５桁目が生産ライン？ それでは、そのあとの ２ は？
同じ生産ラインであることをチェックするなら、６桁目をチェックすればいいのでは？
２．この処理を行う手順が見えないのですが、以下のいずれですか？ １）シートは【生産ライン別】 ２）３号機のものを読み込む場合は、３号機用のシートをアクティブシートにして実行。 ３）３号機用のシートには、すでに過去に読み取られた３号機の商品が何行か記載されている。 （新規の生産ラインで最初の１行の場合は、その読み込みを信じるしかないですが）
あるいは
１）シートは各生産ライン混在の１枚 ２）作業手順としては、今から処理するのは３号機だけだと、そういった段取り。 ３）３号機の処理をしているときに２号機のものが混ざっていればＮＧ
３．A1:A10、A1:A100
質問したかったのは、10 であれ 100 であれ 1000 であれ、行数に何か制限があるのか、 そうではなく、要は、A列のデータ最後までを（それが10,000行でも）対象としていいのかということです。
４． >で、「不具合は・・・？」発生しました。 >このコードをsheetモジュールの最後（前回あげたコードの後）にそのまま貼り付けたらもちろんコンパイルエラーとなりました
そのことを指摘したのではありません。このコードでは 重複していた場合、重複メッセージの後 target.Value = "" を実行してますね。
新規ブックのシートモジュールに以下のコードを貼り付けて、そのシートの任意のセルに何か値を入力してみてください。 コードの不具合が実感できるはずです。実感できたら、メッセージボックスが表示された状態で、Ctrl/Alt/Pause を押して終了させてください。
Private Sub Worksheet_Change(ByVal Target As Range)
MsgBox "Hello"
Target.Value = ""
End Sub
５．>一つだけ変わった結果になったところがありました。フォームのテキストボックス内に前回入力した情報が残ってしまいます。
そうですね。そちらのコードではその都度、Unload 、私がアップしたものは Hide だけですので、そうなりますね。 ここは、追加要件を加味する際に追加しましょう。
いずれにしても、１．～３．に回答をもらえれば、それらを加味したフルセットコード案は、割合と簡単にできそうです。 その際には(マナ)さんがアドバイスされる、他の情報のラベル表示も取り入れたいですね。
（β） 2015/04/29(水) 07:03
とりあえず アイテムチェックは D1 の５桁に対して行うことにします。 シートモジュールは変更ありません。ユーザーフォームモジュールを以下でリバイス。 (マナ)さんからでているリコメンデーションについては、以下のコードには盛り込んでいません。 でも、是非検討されたらよろしいと思います。
Option Explicit
Dim GYO As Long Dim oldName As String
Private Sub UserForm_Initialize()
' 現在選択行を取得
' 見出しか未登録行の場合は新規登録と判断
If ActiveCell.Row = 1 Or ActiveCell.Value = "" Then
GYO = Range("A" & Rows.Count).End(xlUp).Offset(1).Row
TXT_NAME.Text = ""
TXT_CODE.Text = ""
TXT_DEPT.Text = ""
oldName = ""
Else
' 既存行の場合は修正と判断
GYO = ActiveCell.Row
TXT_NAME.Text = Cells(GYO, 1).Value ' 商品コード
TXT_CODE.Text = Cells(GYO, 2).Value ' 作業者コード
TXT_DEPT.Text = Cells(GYO, 3).Value ' 部署
oldName = Cells(GYO, 1).Value ' 商品コード
End If
'シートは保護のまま、マクロでの扱いをＯＫにする。
ActiveSheet.Protect UserInterfaceOnly:=True
End Sub
' ｢登録｣ボタンのクリックイベント
Private Sub CMD_OK_Click()
Dim tCode As String
Dim dept As String
Dim cName As String
Dim strMSG As String
Dim z As Variant
cName = Trim$(TXT_NAME.Text) ' 商品コード
dept = Trim$(TXT_DEPT.Text) ' 部署
tCode = Trim$(TXT_CODE.Text) ' 作業者コード
'商品コードのチェック
If cName = "" Then
strMSG = "商品コードが入力されていません。"
ElseIf Len(cName) <> 14 Then '念のため（手入力)
strMSG = "商品コードは14桁で入力してください"
ElseIf oldName <> cName And IsNumeric(Application.Match(cName, Range("A1", Range("A" & Rows.Count).End(xlUp)), 0)) Then
strMSG = "商品コードが重複しています"
ElseIf Left(cName, 5) <> Range("D1").Value Then
strMSG = "商品コードのアイテムが間違っています"
'部署のチェック
ElseIf dept = "" Then
strMSG = "部署が入力されていません。"
'作業者コードのチェック
ElseIf tCode = "" Then
strMSG = "作業者コードが入力されていません。"
ElseIf IsNumeric(tCode) <> True Then
strMSG = "作業者コードが数字ではありません。"
ElseIf Len(tCode) <> 4 Then
strMSG = "作業者コードは4桁で入力して下さい。"
End If
' チェックでエラーの場合は登録しない
If strMSG <> "" Then
MsgBox strMSG, vbExclamation ' ｴﾗｰ表示
Exit Sub
End If
' チェックOKで更新処理
Cells(GYO, 1).Value = cName ' 商品コード
Cells(GYO, 2).Value = tCode ' 作業者コード
Cells(GYO, 3).Value = dept ' 部署
'登録後、テキストボックスをクリア
TXT_NAME.Text = ""
TXT_CODE.Text = ""
TXT_DEPT.Text = ""
Me.Hide ' ﾌｫｰﾑを非表示
End Sub
（β） 2015/04/29(水) 09:09
質問1、2についてですが、実際のライン構成にについてご説明し質問の答えになればと思います
前工程と後工程とがあり、前工程の生産ラインが2つ（前工程1号、前工程2号）あります
後工程の生産ラインが10ラインあります（後工程1号、後工程2,3,4・・・10号）
前工程の2つのラインでＡ0001～Ａ0010まで１０種類のアイテムを生産します。
ここでバーコードが割り振られます
Ａ0001 （1） 150420 11 は アイテムＡ0001を 前工程（1）号で ４月２０日つくった 11番目の商品
基本的に前工程1号はＡ0001～Ａ0005まで5種類を生産し、前工程2号はＡ0006～Ａ0010まで５種類を生産します。
しかし、顧客のオーダーによって、Ａ0001とＡ0009だけ生産とか、Ａ0001だけをいつもの5倍ほしいとか変則的なオーダーもあります。
（β）さまならすでに冒頭でご理解したかとおもいますがもう少し。
それらが後工程に流れてきて、後工程1号にはＡ0001を仕上げる工程なのでＡ0001しか投入できません。後工程３号はＡ0003だけ・・・
後工程にとってはＡ0001（1）でもＡ0001（2）でも関係ありません。何かあった時のトレーサビリティーとしてコードに載せているだけです。
生産ラインを定義せず混乱させてしまったこと（β）さまの手をわずらわせてしまったことあらためてお詫びします。
で、やはり感動です。さっそく明日から試してみます。
ありがとうございました。
感動したので感想も
コードをみると素人ながら「＝」が多く使用され何か定義づけてるなーと感じます。だから意味はわからなくてもそのコードをたどって必要ないなら
消してみたりあるいは足してみたりできそうな感じもします。わからないけどわかりやすいそんな感じがいたしました。
あと日本語訳も親切に書いていただきありがとうございます。
（マナ）様アドバイスありがとうございました。（β）さまのコードをもとに勉強させていただきます。
（みお） 2015/04/29(水) 22:19
お世話になっております。みおです。
以前（β）さまよりお教えいただいたシステムは順調に稼働しております。
ひとえに（β）さまのおかげです。ありがとうございます。
ご質問させていただく内容は、上記コード【※2015/4/29（水）09：09より】
商品コードのチェックにMsg="消費期限切れです。"を追加したいのですが条件のとり方、
書き方がわかりません。
商品コード内の日付コードに消費期限日数を足した日付が、入力日（今日）をすぎていたらメッセージを表示して入力制限をかけることは可能でしょうか？
各アイテム にはそれぞれ定められた消費期限日数があります
例Ａ0001＝10日間、Ａ0002＝15日間 などです。
そこでまず関数で自分でできるところまでこころみました（まとはずれかもしれませんが）
※項目にもろもろ表示内容がありＡ6から入力開始します
1、別枠にリストをつくり、VLOOKUPで日付（消費期限日数）を呼び出しました
Ａ6にＡ00012042011と入力されるとリストを参照し、Ｊ6に10（10日間）と表示させました。 Ｊ6結果＝10
2、Ｇ6には関数「＝MID(A6,7,6)」日付だけを表示させました。Ｇ6結果＝150420
3、Ｈ6には関数「＝TEXT(G6,"00!/00!/00")*1」を入れＧ6を日付データに変換しました。
Ｈ6結果＝2015/4/20
4、Ｉ6には関数「＝Ｈ6+Ｊ6」といれました。Ｉ6結果＝150430（表示形式yymmdd)
Ｉ6がtoday（now?)を過ぎていたらMsg="消費期限切れです。"と表示され、入力できないようなものができないか、
もしくは、（素人の勝手な考えで）1、Ｊ6の「10」の情報だけで今日の日付を過ぎていたらMsg="消費期限切れです。"と表示され、入力できないというようなものができるのでしょうか？
どうかご教授お願いたします。
（みお） 2015/05/20(水) 22:59
思い出す時間を少しください。
>>そこでまず関数で自分でできるところまでこころみました
大変よろしいアプローチだと思います。 ただ、あらかじめ関数を何行目までいれておくかが悩ましいですかね？ 関数を埋めてある行数以上にデータが入ると、ちょっと困りますね。 VLOOKUPの式をアップしてもらえますか？
それと、βとしては、常々、TODAY関数を使うのを好みません。当日の処理を後追いで翌日行うと 当日日付ではなく翌日日付基準になってしまいますので。
今回の場合は生産ラインの現場処理ですから、必ず当日に行われると考えていいですか？ つまり、当日の処理が間に合わず、翌日、休日出勤して作業するとか、深夜シフトがあって、作業中に日付がかわるということは 無いと考えていていいのですね？
（β） 2015/05/21(木) 05:49
とりあえずCMD_OK_Clickを以下で置き換えてやってみてください。 なお賞味期限リスト領域に名前の定義で "賞味期限" という名前を設定しておいてください。
' ｢登録｣ボタンのクリックイベント
Private Sub CMD_OK_Click()
Dim tCode As String
Dim dept As String
Dim cName As String
Dim strMSG As String
Dim z As Variant
Dim d As Variant
cName = Trim$(TXT_NAME.Text) ' 商品コード
dept = Trim$(TXT_DEPT.Text) ' 部署
tCode = Trim$(TXT_CODE.Text) ' 作業者コード
z = Application.VLookup(Left(cName, 5), Range("賞味期限"), 2, False)
d = Mid(cName, 7, 6)
'商品コードのチェック
If IsError(z) Then
strMSG = "賞味期限テーブルに " & Left(cName, 5) & " の登録がありません"
ElseIf Not IsNumeric(d) Then
strMSG = "商品コード内の製造年月日が数字ではありません"
ElseIf DateSerial(Left(d, 2), Mid(d, 3, 2), Right(d, 2)) + z < Date Then
strMSG = "賞味期限が過ぎています"
ElseIf cName = "" Then
strMSG = "商品コードが入力されていません。"
ElseIf Len(cName) <> 14 Then '念のため（手入力)
strMSG = "商品コードは14桁で入力してください"
ElseIf oldName <> cName And IsNumeric(Application.Match(cName, Range("A1", Range("A" & Rows.Count).End(xlUp)), 0)) Then
strMSG = "商品コードが重複しています"
ElseIf Left(cName, 5) <> Range("D1").Value Then
strMSG = "商品コードのアイテムが間違っています"
'部署のチェック
ElseIf dept = "" Then
strMSG = "部署が入力されていません。"
'作業者コードのチェック
ElseIf tCode = "" Then
strMSG = "作業者コードが入力されていません。"
ElseIf IsNumeric(tCode) <> True Then
strMSG = "作業者コードが数字ではありません。"
ElseIf Len(tCode) <> 4 Then
strMSG = "作業者コードは4桁で入力して下さい。"
End If
' チェックでエラーの場合は登録しない
If strMSG <> "" Then
MsgBox strMSG, vbExclamation ' ｴﾗｰ表示
Exit Sub
End If
' チェックOKで更新処理
Cells(GYO, 1).Value = cName ' 商品コード
Cells(GYO, 2).Value = tCode ' 作業者コード
Cells(GYO, 3).Value = dept ' 部署
'登録後、テキストボックスをクリア
TXT_NAME.Text = ""
TXT_CODE.Text = ""
TXT_DEPT.Text = ""
Me.Hide ' ﾌｫｰﾑを非表示
End Sub
（β） 2015/05/21(木) 08:21
賞味期限リストＬ10：Ｍ10に"賞味期限"と名前を定義しました。
みごと！賞味期限の制限かけることができました。ありがとうございました。
「今回の場合は生産ラインの現場処理ですから、必ず当日に行われると考えていいですか？
つまり、当日の処理が間に合わず、翌日、休日出勤して作業するとか、深夜シフトがあって、作業中に日付がかわるということは
無いと考えていていいのですね？」
についてですが、稀ですが（β）さまご懸念のとおり作業中に日付がかわることがありました。脱帽です。
業務上の日付のかわるタイミングはその日のシフト終了時です。
夜間、5/20の0：00をこえても5/20日分として製造します。
その場合の対応をまず私のレベルで考えてみました。
シート１日ごと使います。日付をセルＧ1に表示します。例Ｇ1に5/21 →５月21日
シート1！セルＧ1に5/1、シート2！セルＧ1に5/2、・・・シート31！セルＧ1に5/31
セルＧ1の日付を過ぎたら・・・のような方法でその日の作業に対して期限の制限をかけられるか考えました。
見よう見まねで < Date Thenのところを < Range("G1").Value Thenに変えてみました。
結果、一応制限がかけられるようになりました。
ElseIf DateSerial(Left(d, 2), Mid(d, 3, 2), Right(d, 2)) + z < Date Then
strMSG = "賞味期限が過ぎています"
ElseIf DateSerial(Left(d, 2), Mid(d, 3, 2), Right(d, 2)) + z < Range("G1").Value Then
strMSG = "賞味期限が過ぎています"
よく意味は分かっておりませんが、これで問題はないのでしょうか？
ご教示お願いいたします。
（みお） 2015/05/22(金) 00:44
対応された解決策は、きわめて理にかなった方法ですね！ 事務処理系プログラムでは、この日付の跨りは結構、日常ありうることとして、 たとえば月次処理であれば、今は何月なんだ、日時処理なら、今は何日なんだという情報を 管理者が設定し、プログラムはそれを参照するということが定番といっても過言ではないですね。
たとえば工場の生産ラインでは 26:00 までが当日といった運用もあり、26:00に向けた生産が完了した時点で 日付情報を更新したりしますね。
ということで、日別のシートというのはグッドアイデアです。 １枚のシートで、そのG1を当該生産が終了した時点で、管理者が直すということも考え方としてはありえますが そうすると、夜中まで管理者がスタンバイしなければいけない。一方、それを生産現場の人に、お願いねといっても 忘れたりしますからねぇ。
ということで、コードは、(みお)さんが調整されたように Date を Range("G1").Value に変えたもので問題ありません。
もし懸念あるとすれば、うっかり別のシートを表示して処理をしてしまったときでしょうか。
ユーザーフォームに Activateイベント処理を追加しておくといいかもしれません。
Private Sub UserForm_Activate()
If Range("G1").Value <> Date Then
If MsgBox("シート日付が " & Range("G1").Value & " ですが、よろしいのですか？", vbYesNo + vbExclamation) = vbNo Then Me.Hide
End If
End Sub
なお、Hide にしてあるのは、現在のCMD_OK_ClickでHideにしているのを踏襲したものです。 ここは、いずれも Unload Me のほうがいいのでは？ と思っていますが。
それと、シートを分けるということはシートモジュールも、各シートに（同じものを）記述必要ですね。 おそらくシートをコピーして準備されるのでしょうから、実際に記述はされないでしょうけど、もし ロジック変更を行う場合、すべてのシートのコードを変更しなければいけなくなりますね。
なので、シートモジュールから ThisWorkbookモジュールに引っ越しさせて、１つのプロシジャで 賞味期限シート以外のすべてのシートのイベント処理をしたほうがいいかもしれません。
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
'リストシートは対象外
If Sh.Name = "ｘｘｘｘ" Then Exit Sub 'ｘｘｘｘは実際のシート名に。
' 商品コード列のみを対象とする
If Target.Column = 1 Then FRM_USER.Show
End Sub
（β） 2015/05/22(金) 05:54
strMSG = "商品コードが重複しています"
新たに２桁が追加されたことで１４桁までが重複していても15桁目、１６桁目が違うと重複していないと判断してしまう。
問題点2
1画面で2つのブックを開いて使用する場合、MsgBoxがwindows画面中央に表示され、どちらのブックのメッセージか混乱してしまう。
また２画面（マルチモニタ）を使用すると操作画面ではない画面の方にMsgBoxが表示されるケースもある。
２つの問題を解決できないか、素人の私なりにわかるところまで調べてみました。
問題点1は、
Left（cName,14)を対象して制限をかける
※ElseIf oldName <> cName And IsNumeric(Application.Match(cName, Range("A1", Range("A" & Rows.Count).End(xlUp)), 0)) Then
strMSG = "商品コードが重複しています"
上記にLeft（cName,14)を代入したりしたりしてみましたが
結果
できませんでした。
問題点2は、
UserFormならWorkBookの中央に表示されるので、（座標も指定できるので）各エラー表示（11個）に対しUserForm（1～11）を挿入し、
ラベルで各エラー内容を表示。
例えば
'商品コードのチェック
の下記の部分を
ElseIf DateSerial(Left(d, 2), Mid(d, 3, 2), Right(d, 2)) + z < Range("G1").Value Then
strMSG = " 賞味期限が過ぎています"
下記のように
ElseIf DateSerial(Left(d, 2), Mid(d, 3, 2), Right(d, 2)) + z < Range("G1").Value Then UserForm3.Show ’賞味期限が過ぎています
としたところ、ユーザーフォームに"賞味期限が過ぎています"は表示されましたが、表示されたユーザーフォームの×ボタンを押すと期限が切れて
いても入力されてしまった。
結果
できませんでした
また各ユーザーフォームにCommandButton1を追加してstrMsgと同じ動きができないかやってみましたが
結果
できませんでした
だいぶ前置きが長くなりましたが要望が2つです
問題点1、の要望
重複エラーを16桁のうち左から14桁にだけ参照したい
問題点2、の要望
MsgBoxをwindows画面の中央ではなくエクセルブックの中央に表示させたいので、strMSGではなく、ユーザーフォームで表示させてstrMSGと同じような動きをさせたい
まず、やろうとした方向性もあっているのかわかりませんが、2つの要望に対してご教示お願いいたします。
現在最新のユーザーフォームのコードを上げます
※変更点
ElseIf Len(cName) <> 14 Then '念のため（手入力)
strMSG = "商品コードは14桁で入力してください"
14を16に変更
Me.HideをUnload Meに変更
※（β）さまのおっしゃるとおりMe.Hideでは連続入力する場合、更新されずうわがきされてしまう不具合がありました。
現在
Option Explicit
Dim GYO As Long
Dim oldName As String
Private Sub TXT_DEPT_Change()
End Sub
Private Sub UserForm_Initialize()
' 現在選択行を取得
' 見出しか未登録行の場合は新規登録と判断
If ActiveCell.Row = 1 Or ActiveCell.Value = "" Then
GYO = Range("A" & Rows.Count).End(xlUp).Offset(1).Row
TXT_NAME.Text = ""
TXT_CODE.Text = ""
TXT_DEPT.Text = ""
oldName = ""
Else
' 既存行の場合は修正と判断
GYO = ActiveCell.Row
TXT_NAME.Text = Cells(GYO, 1).Value ' 商品コード
TXT_CODE.Text = Cells(GYO, 2).Value ' 作業者コード
TXT_DEPT.Text = Cells(GYO, 3).Value ' 部署
oldName = Cells(GYO, 1).Value ' 商品コード
End If
'シートは保護のまま、マクロでの扱いをＯＫにする。
ActiveSheet.Protect UserInterfaceOnly:=True
End Sub
' ｢登録｣ボタンのクリックイベント
Private Sub CMD_OK_Click()
Dim tCode As String
Dim dept As String
Dim cName As String
Dim strMSG As String
Dim z As Variant
Dim d As Variant
cName = Trim$(TXT_NAME.Text) ' 商品コード
dept = Trim$(TXT_DEPT.Text) ' 部署
tCode = Trim$(TXT_CODE.Text) ' 作業者コード
z = Application.VLookup(Left(cName, 5), Range("賞味期限"), 2, False)
d = Mid(cName, 7, 6)
'商品コードのチェック
If IsError(z) Then
strMSG = "賞味期限テーブルに " & Left(cName, 5) & " の登録がありません"
ElseIf Not IsNumeric(d) Then
strMSG = "商品コード内の製造年月日が数字ではありません"
ElseIf DateSerial(Left(d, 2), Mid(d, 3, 2), Right(d, 2)) + z < Range("G1").Value Then
strMSG = "賞味期限が過ぎています"
ElseIf cName = "" Then
strMSG = "商品コードが入力されていません。"
ElseIf Len(cName) <> 16 Then '念のため（手入力)
strMSG = "商品コードは16桁で入力してください"
ElseIf oldName <> cName And IsNumeric(Application.Match(cName, Range("A1", Range("A" & Rows.Count).End(xlUp)), 0)) Then
strMSG = "商品コードが重複しています"
ElseIf Left(cName, 5) <> Range("D1").Value Then
strMSG = "商品コードのアイテムが間違っています"
'部署のチェック
ElseIf dept = "" Then
strMSG = "部署が入力されていません。"
'作業者コードのチェック
ElseIf tCode = "" Then
strMSG = "作業者コードが入力されていません。"
ElseIf IsNumeric(tCode) <> True Then
strMSG = "作業者コードが数字ではありません。"
ElseIf Len(tCode) <> 4 Then
strMSG = "作業者コードは4桁で入力して下さい。"
End If
' チェックでエラーの場合は登録しない
If strMSG <> "" Then
MsgBox strMSG, vbExclamation ' ｴﾗｰ表示
Exit Sub
End If
' チェックOKで更新処理
Cells(GYO, 1).Value = cName ' 商品コード
Cells(GYO, 2).Value = tCode ' 作業者コード
Cells(GYO, 3).Value = dept ' 部署
'登録後、テキストボックスをクリア
TXT_NAME.Text = ""
TXT_CODE.Text = ""
TXT_DEPT.Text = ""
Unload Me ' ﾌｫｰﾑを非表示
End Sub
（みお） 2015/06/02(火) 03:15
とりいそぎ。
今から２日間、他出しますので、以降のレスは木曜日以降になります。
１．ユーザーフォームをつくってください。名前は、たとえば ERR_RORM CommandButton1 と Label1 を配置。 ２．ERR_RORMのユーザーフォームのモジュールは以下だけ。
Private Sub CommandButton1_Click()
Unload Me
End Sub
３．現在のフォームのモジュールに以下を追加
Private Sub ErrShow(msg As String)
With ERR_FORM
.Label1 = msg
.Show
End With
End Sub
４．現在のフォームの
MsgBox strMSG, vbExclamation ' ｴﾗｰ表示
を
ErrShow strMSG
(今後エラーメッセージを追加し、この扱いにするなら、同じ要領で MsgBox のかわりに ErrShow を使ってください)
５．１４桁でチェックは Match をワイルドカードで使いましょう。
ElseIf oldName <> cName And IsNumeric(Application.Match(cName, Range("A1", Range("A" & Rows.Count).End(xlUp)), 0)) Then
これを
ElseIf oldName <> cName And IsNumeric(Application.Match(Left(cName,14) & "*", Range("A1", Range("A" & Rows.Count).End(xlUp)), 0)) Then
で試してください。
（検証をしていないので不具合あれば、木曜日までお待ちください)
（β） 2015/06/02(火) 05:51
今から出かけますが、その前に。
各種フォームがあり、それぞれでエラーメッセージ処理があるならErrShowを各ユーザーフォームモジュールに記述せず 標準モジュールに Private を省いて１つだけ記述するほうがいいですね。
（β） 2015/06/02(火) 06:52
（みお） 2015/06/06(土) 08:22
ＯＲ文の書き方でつまずいております。
現在の文（ユーザーフォームモジュール 中盤）
1 ElseIf Left(cName, 5) <> Range("D1").Value Then
strMSG = "商品コードのアイテムが間違っています"
上記文1 に"D1"もしくは"D2"としたい場合、どのように書いたらよいのかお教え願いますでしょうか。
※現在まで1つの商品コード（"D1")以外は"商品コードのアイテムが間違っています"としておりました。
商品アイテムが増加により、２つ（"D2")の商品コードを増やしたいです。
（素人考えでいくつか試しましたが失敗。失敗例下記2）
2 ElseIf Left(cName, 5) <> Range("D1").Value OR Left(cName, 5) <> Range("D2").Value Then
※2の結果は1と同じでした。Ｄ2の商品コード入力→"商品コードのアイテムが間違っています"と表示されてしまいました。
Ｄ1の商品コードを入力してもＤ2の商品コードを入力しても入力できる（"商品コードのアイテムが間違っています"が表示されない）ようにしたい
ＯＲ文をどのように書いたらよいのかご教示願います。
よろしくお願いいたします。
（みお） 2015/08/30(日) 21:46
D2の時、メッセージを出す行を飛ばして部署チェックにいきたいということですね 商品コードがD2の時は、"D1以外だった時"にあたります "D1以外だった時"の判定のあとに、同じように、"D2以外だった時"をいれてあげれば解決です
ElseIf Left(cName, 5) <> Range("D1").Value Then
If Left(cName, 5) <> Range("D2").Value Then
strMSG = "商品コードのアイテムが間違っています"
End IF
'部署のチェック
今まで通り、D1の時は最初のIf文でFalseとなり、次行のIf文を飛ばして部署チェックに行きます D2の時は、"D1以外だった時"の判定でTrueとなり次行へ "D2以外だった時"の判定でFalseになるので、部署チェックに行きます D1でもD2でもなければ、どちらのIf文もTrueとなり、メッセージが表示されます If文にORやANDをくっつけるよりも、後々修正しやすいと思います(※個人的な意見です) （もにょ） 2015/08/31(月) 10:55
しばらく間が空いたので要件をすっかり忘れています。
記憶では
ElseIf Left(cName, 5) <> Range("D1").Value Then
ここは 入力された商品名の先頭5桁が D1の値と【異なっていれば エラー】 ということだったと思います。
>>Ｄ1の商品コードを入力してもＤ2の商品コードを入力しても入力できる 今回は D1 または D2 と 「同じならＯＫ」にしたいのですね？
（もにょ）さんのアドバイスのように、条件式は分離しておいたほうが、何かとメンテしやすいですし、実は 処理効率も、分離（If のネスト)のほうが優れているということもありますが、とりあえず１つで書くなら
If IsError(Application.Match(Left(cName, 5), Array(Range("D1").Value, Range("D2").Value), 0)) Then
こんな書き方がありますね。
（β） 2015/08/31(月) 11:21
（みお） 2015/08/31(月) 22:23
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.