スキルアップ・問題解決なら、モーグにおまかせ！

いつも参考にさせていただいています。
 
備品庫の在庫管理をExcelで行っています。
新規登録や入出庫の管理をオートメーション化したいとの要望があり、VBAと格闘しています。
 
新規に備品を登録する時に、カテゴリ別に自動で採番したいのですが、
VBAのロジックが全く浮かばず迷宮入りしています。
良きアイデアをお持ちの方がいらっしゃればご教授お願いいたします。
 
 
　目的：アイテムを新規登録する際にCodeをカテゴリ別に自動採番したい
 
　採番例：A030001
　　A：支店略称
　　03：カテゴリ分類
　　0001：カテゴリ別の連番
 
 
マスターシートには下記のように登録したい
 
　A列　　　　　B列　　　　　　　　C列
Code 　　　アイテム名称　　　　　カテゴリID
A030001　　サージカルマスクM 　　　 3
A020003　　液体洗剤S　　　　　 　　2
A020004　　液体洗剤E　　　　　　　 2
 
※支店名称（A）は常に（A）を使用し変更はありません
※カテゴリ分類はリストから選択する形を想定しています
 
C列「カテゴリID」をカウントして、１足せばCodeは導き出せるのではないかというイメージはあるのですが、
VBA初心者のため具体的なロジックが浮かびません。
アドバイスを頂戴できれば幸いです、よろしくお願いします。
 

＞C列「カテゴリID」をカウントして、１足せばCodeは導き出せる
 
ワークシート関数にCOUNTIFがありますので、それを活用したらどうですか？
 
WorksheetFunction.CountIf(Worksheets("Master").Columns("C"), 求めたいカテゴリ分類) + 1

カテゴリ別に連番を振りたいということでしょうか。
 
Code 　　　アイテム名称　　　　　カテゴリID
A030001　　サージカルマスクM 　　　 3
A020001　　液体洗剤S　　　　　 　　2
A020002　　液体洗剤E　　　　　　　 2
 
ではなくて、
 
Code 　　　アイテム名称　　　　　カテゴリID
A030001　　サージカルマスクM 　　　 3
A020003　　液体洗剤S　　　　　 　　2
A020004　　液体洗剤E　　　　　　　 2
 
となるのは、どのようなロジックでしょうか。

半平太様
早速ご回答いただきありがとうございます。
CountIf関数がVBAでも使えるのですね！ご教授ありがとうございます。
 
 

半平太 さんの引用:
＞
WorksheetFunction.CountIf(Worksheets("Master").Columns("C"), 求めたいカテゴリ分類) + 1

hatenaさん、コメントありがとうございます。
 

hatena さんの引用:
カテゴリ別に連番を振りたいということでしょうか。
 
Code 　　　アイテム名称　　　　　カテゴリID
A030001　　サージカルマスクM 　　　 3
A020001　　液体洗剤S　　　　　 　　2
A020002　　液体洗剤E　　　　　　　 2
 
ではなくて、
 
Code 　　　アイテム名称　　　　　カテゴリID
A030001　　サージカルマスクM 　　　 3
A020003　　液体洗剤S　　　　　 　　2
A020004　　液体洗剤E　　　　　　　 2
 
となるのは、どのようなロジックでしょうか。

1行目が項目名、2行目からデータとして、
A2に下記の式を設定して、下にコピーすればご希望の結果になります。
  
="A"&TEXT(C2,"00")&TEXT(COUNTIF($C$2:C2,C2),"0000")
 
  
VBAでやりたいということなら、A列にVBAで上記の式を設定して、値代入すればいいでしょう。
  
Sub Sample()
    Dim rng As Range
    Set rng = Range("A1").CurrentRegion.Offset(1)
    Set rng = rng.Resize(rng.Rows.Count - 1, 1)
    rng.Formula = "=""A""&TEXT(C2,""00"")&TEXT(COUNTIF($C$2:C2,C2),""0000"")"
    rng.Value = rng.Value
End Sub

連想配列(Dictionary)を使うコード例
 
Sub Sample2()
    Dim d As Object
    Set d = CreateObject("Scripting.Dictionary")
     
    Dim rng As Range
    Set rng = Range("A1").CurrentRegion.Offset(1)
    Set rng = rng.Resize(rng.Rows.Count - 1, 1)
     
    Dim c As Range, k
    For Each c In rng
        k = c.Offset(, 2).Value
        d(k) = d(k) + 1
        c.Value = "A" & Format(k, "00") & Format(d(k), "0000")
    Next
End Sub

hatena さん
大変丁寧にご教授くださりありがとうございます。
VBA初心者の私にも理解することができました。
 
早速２つのコードを実行してみました。
Sample でご教授いただいた、TEXT関数とCOUNTIF関数を代入する方法はスムーズにいきました。
シンプルでいいですね。
 
Sample2 の連想配列（Dictionary）を使うコードの方が応用が効きそうで良いと思ったのですが
実行してみたところ
「実行時エラー：429」
と表示されました。
 
もう少し格闘してみたいと思います。
 
取り急ぎお礼まで。

本当に新規なら その考え方でも良いでしょう。
 
この考え方の場合、計算時点でのリストに対し 1から採番をしています。
 
既に
　そのカテゴリID に対し発番済み
　　 かつ、
　リストに 発番済みの 全てのアイテムが発番順に並んでいない
　　の場合、番号に重複が出たり、既に採番済みだった番号に 別な番号が採番されてしまいます。
 
 
新規アイテムだけのリストに対し採番を行いたい場合には
・各カテゴリID の カテゴリ別の連番 の最大値を MAXIFS関数等で取得するか
・各カテゴリID の 採番した番号をどこかに保存しておき、採番後にその番号を +1 しておく
　　（各カテゴリID の カテゴリ別の 次の連番を指定しておく）
あたりを採る事が多いです。
 
 
廃番を含めた発番済みのリスト に 新規採番を行いたいアイテムを追加する業務フローなら
VBAを使用せず、MAXIFS関数を使えば良いですよ。

Suzu様
 
具体的な方法をご教授いただきありがとうございます。
そして感謝が遅くなりまして申し訳ありません。
 

Suzu さんの引用:

新規アイテムだけのリストに対し採番を行いたい場合には
・各カテゴリID の カテゴリ別の連番 の最大値を MAXIFS関数等で取得するか
・各カテゴリID の 採番した番号をどこかに保存しておき、採番後にその番号を +1 しておく
　　（各カテゴリID の カテゴリ別の 次の連番を指定しておく）
あたりを採る事が多いです。

Suzu さんの引用:

廃番を含めた発番済みのリスト に 新規採番を行いたいアイテムを追加する業務フローなら
VBAを使用せず、MAXIFS関数を使えば良いですよ。

１．「マスター」と「備品コード一覧」は同じものですか？
 
＞　採番例：A030001
＞　　A：支店略称
＞　　03：カテゴリ分類
＞　　0001：カテゴリ別の連番
　　↑
２．その様な簡単な登録メニューだと、「液体洗剤S」とかのアイテム名称がないので、
　　自動採番は出来ても、自動登録は情報不足で出来ないですよ？
　　オートメーション化したいなら、そこも盛り込む必要があります。
 
　　もしかして、実際の登録メニューには既にそんな情報もあるんですか？
　　あるなら、そのレイアウトをアップしてください。

半平太様
いつも的確なアドバイスをありがとうございます。
 

半平太 さんの引用:
１．「マスター」と「備品コード一覧」は同じものですか？

半平太 さんの引用:

＞　採番例：A030001
＞　　A：支店略称
＞　　03：カテゴリ分類
＞　　0001：カテゴリ別の連番
　　↑
２．その様な簡単な登録メニューだと、「液体洗剤S」とかのアイテム名称がないので、
　　自動採番は出来ても、自動登録は情報不足で出来ないですよ？
　　オートメーション化したいなら、そこも盛り込む必要があります。
 
　　もしかして、実際の登録メニューには既にそんな情報もあるんですか？
　　あるなら、そのレイアウトをアップしてください。

＞今回は「カテゴリ別の自動採番」についての質問スレッドのため
そうですか。
 
なら、登録メニューシートが下のレイアウトだとした場合

<登録メニュー >
行  __________A__________  ___B___
 1  自動採番処理                  
 2  支店略称               　　A      
 3  カテゴリ分類               02
 4  カテゴリ別自動採番→   A020005　←上の2つが入力されると、
                                      その直後に新しい番号が表示される。

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim wsMast As Worksheet
    Dim r As Range
    Dim aCell As Range
    Dim Category As String
    Dim maxNo As Long
    
    If Target.CountLarge > 1 Then
        Exit Sub
    ElseIf Intersect(Target, Range("B2:B3")) Is Nothing Then
        Exit Sub
    ElseIf Application.CountA(Range("B2:B3")) < 2 Then
        Application.EnableEvents = False
            Range("B4") = Empty
        Application.EnableEvents = True
        Exit Sub
    End If
    
    Category = Range("B2") & Range("B3")
    
    Set wsMast = Worksheets("備品コード一覧")
    Set r = wsMast.Range("A2", wsMast.Cells(Rows.Count, "A").End(xlUp))
    
    For Each aCell In r
        If Left(aCell.Value, 3) = Category Then
            maxNo = Application.Max(CLng(Right(aCell.Value, 4)), maxNo)
        End If
    Next
    
    Application.EnableEvents = False
        Range("B4") = Category & Format(maxNo + 1, "0000")
    Application.EnableEvents = True
End Sub

半平太様
 
大変丁寧なコードをご教授いただきましてありがとうございます。
素人の私にも読み取れるわかりやすいコードで大変有り難く思います。
備品コード一覧の最終行にMaxNoを追加する、という動きですね。
私の拙い説明から、やりたいことをすべて正確に読み取ってくださって有難うございます！！
早速実装して試してみたいと思います。
 
実装してみた結果は改めて報告させていただきます。
本当にご丁寧にありがとうございます。
取り急ぎ御礼のみで失礼いたします。

＞備品コード一覧の最終行にMaxNoを追加する、という動きですね。
 
ちょっとニュアンスが違うのですが・・
同じカテゴリ(支店+カテゴリ分類)の中で、一番大きな番号を特定するものです。
 
途中に欠番があろうが、最終行に小さな番号が潜んでいようが、
とにかく同カテゴリの中で最大の番号(MaxNo) を確定し、
それに+1をしたものを新番号とする作りです。