ユーザーフォーム上での採番のVBAのコード

質問

Excel2007でトラブル履歴シートを作成しています。入力項目が多いので、入力をしやすくする為に、ユーザーフォームを用いた入力フォームを作成しいます。それで、管理方式で管理No.(全体)と発行Noの(月単位管理)が必要になり、エクセルシート(Sheet2)内とユーザーフォーム上に下記の項目を作っています。
B列にトータル管理No.
C列に月単位管理No.
D列にチェック欄
E列に対策完了日
F列にトラブル発生日
あと、数項目程ありますが、
今回は、ユーザーフォームに作成したテキストボックス(トータル管理No.)にコマンドボタンをクリックしたら、B列の最終番号から次の番号を習得します。
トータル管理No.桁数は４桁若しくは5桁で、全て数字の表記での管理となります。また、発行No.では、月が変わった時に件数が、0001になるようにしたいです。どなたかVBAコードについて教えてください。

この投稿のマルチメディアは削除されているためご覧いただけません。

回答No.4

mt2015 · ベストアンサー

こんな感じでしょうか。
Text1 がトータル管理No、Text2が月単位管理Noが入るテキストボックス、
Text3がトラブル発生日を入力するテキストボックスとします。

Text3に日付を入れた後、コマンドボタンをクリックします。

Private Sub CommandButton1_Click()
　　　'発生日の確認
　　　sOccDate = TextBox3.Text
　　　If IsDate(sOccDate) = False Then
　　　　　　MsgBox ("発生日が不正です")
　　　　　　Exit Sub
　　　End If
　　　dOccDate = CDate(sOccDate)
　　　sOccMonthS = Format(CDate(sOccDate), "YYYY/MM/01")
　　　sOccMonthE = DateAdd("M", 1, DateValue(sOccMonthS))

　　　With Worksheets("Sheet2")
　　　　　　'新トータル管理No
　　　　　　nTotal = Application.WorksheetFunction.Max(.Range("B:B")) + 1
　　　　　　TextBox1.Text = Format(nTotal, "00000")

　　　　　　'新月単位管理No
　　　　　　nCount = Application.WorksheetFunction.CountIfs(.Range("F:F"), ">=" & sOccMonthS, .Range("F:F"), "<" & sOccMonthE) + 1
　　　　　　TextBox2.Text = Format(CDate(sOccDate), "YYYY-MM-") & Format(nCount, "000")
　　　End With
End Sub

回答No.3

imogasi

「最終番号」という名の数字を、ユーザーフォーム閉じて、別の日など次の機会に作業する場合に、データを引き継ぎたい場合のテクニックとしては、作業終了時に、テキストファイルで保存しておいて、次の作業時に開いて最終番号を知る、というやり方が最適かつ簡単ではないかな。ＰＵＢＬＩＣ変数とか、プログラムの変数は使えない仕組みと思う。固定メモリに保存しなくてはならないと思う。
高等な分野の話だが、一般にＩＮＩファイルなどでこの考えは使われているように思う。
https://ja.wikipedia.org/wiki/INI%E3%83%95%E3%82%A1%E3%82%A4%E3%83%AB
それ用に、馴染みのエクセルのセルに保存する手もある。専用のシートを作る手もあるが、一般シートでは「なんだこれは？」と目障りかと思う。テキストファイルが一番簡単で処理が軽いとおもう、し表面に出さないでも済む．メモ帳で修正も簡単である。
ーー
デスクトップに「最終番号」ファイルを作った。
中身（メモ帳で）は、たとえば、最終番号の意味で
34
ーー
UserForm_Initializeイベントで
Private Sub UserForm_Initialize()
Open "C:\Users\ｘｘｘ\Desktop\最終番号.txt" For Input As #1
Input #1, a
MsgBox a
UserForm2.TextBox1.Text = a
Close #1
End Sub
実行すると、ユーザーフォｒムのテキストボックスに３４が出る。
#1の「１」やUserForm2の「２」や.TextBox1の「１」は、ユーザーの状況により変わるので注意。使い終わったらClose #1 をすること。
ほかに、正しくは、「次の」番号を使うときは、＝Ｖal(a)+1が正しいだろうが、説明のためのテストなので最終番号を表示している。

回答No.2

mt2015

補足願います。
発行No（月単位管理）の年月は、トラブル発生日の年月ですか？それとも登録日の年月ですか？

内容的にはAccess向きですね。

補足

発行No.はトラブル発生日の年月になります
(例)
管理No.→0001
発生日→2016/12/22
発行No.2016-12-001

回答No.1

ushi2015

こんにちは
画像の発行Noで
2016-11-001が2件有ったり、2016-12が005から始まっているのは間違いですよね？
Sub test()
　　Dim r　　　　As Range
　　Dim 発生年月 As String

　　発生年月 = Format(#12/1/2016#, "yyyy-mm") 'ユーザーフォームの発生日にする事

　　With Worksheets("Sheet2")
　　　　'管理No
　　　　MsgBox Format(.Range("B" & Rows.Count).End(xlUp) + 1, "0000")
　　　　'発行No
　　　　Set r = .Range("C" & Rows.Count).End(xlUp)
　　　　If r Like 発生年月 & "*" Then
　　　　　　MsgBox 発生年月 & "-" & Format(Split(r, "-")(2) + 1, "000")
　　　　Else
　　　　　　MsgBox 発生年月 & "-001"
　　　　End If
　　End With
End Sub
を修正して組み込んでみて下さい。

お礼

早速のソースコードありがとうございます。
説明が上手くなくすいません。
入力者が数人いますので、使い勝手が良く管理しやすい物と思い、他にも色々とやっていて、リリース前の不具合や改善点がないかと、やっている最中なので、表示は気にしないでください。
自分でもサイトを利用しながら、作りあげていっているので、色々と不具合がありますが・・・
あと、1点ありますがこの問題が解決したら、
あらためて投稿しますので、その際はアドバイスをお願いします。