いま注番を自動に取得するようにしています。


 lngSNO = Application.InputBox("開始番号？", Default:=Sheets("控").Range("D65536").End(xlUp) + 1, Type:=1)
    If lngSNO = False Then Exit Sub
 With Worksheets("工事受付票")
        For i = lngSNO To lngSNO
        .Range("AD1").Value = Format(i, "00000")
             Title = "シートのコピー"
             IfMsbox = "工事受付票をコピーします。よろしいですか"
              answer = MsgBox(Msg, vbYesNo, Title)
    If answer = 6 Then
 
この5桁の番号の前2桁を西暦とし【24***】で使用したいと思います


ただ3桁では1000番台になると【25***】となるため翌年重複します。
なので【24999】の次は【2400A】その後【2499A】→【2400B】と取得する
事は可能でしょうか 
または最初から【2400A】から始まり【2499A】→【2400B】と番号を
取得する事が可能でしょうか

最初の【24***】の【24】はセルからとりますので3桁でコードを教えて下さい
000〜999→00A〜99A→00Bへ
又は
00A〜99A→00B〜99B→00Cへ

Excel2019

＞年間1,000になると困るのでアルファベット使用にしたいと。
そうなんですけど、いずれにしても3桁なので、いずれ限界が来ます。

なので、(余裕をみて）何番以上はない、と言う見極めが必要になります。
対策を考えるのはそれが決まってからになります。

あまりよくわかってませんが、以下のようなことでしょうか？
意図したものでなければ、申し訳ありません。
最大「99Z」(=3599)までです。又「A-Z」を使う為、データ型は必然的に「文字列」となります。
MyNo関数の第2引数はセルからとった年度としてください。

Sub test()
    Const stopValue& = 3599
    Dim i&
    [A:B].Clear
    Application.ScreenUpdating = False
    [B:B].NumberFormat = "@"
    [A1] = "10進数": [B1] = "注番"
    [A2].Value = 1
    [A2].DataSeries Rowcol:=xlColumns, Type:=xlDataSeriesLinear, Step:=1, Stop:=stopValue
    For i = 1 To stopValue
        [B1].Offset(i) = MyNo(i, "24")
    Next
End Sub
Function MyNo$(n&, Optional prefix$ = "")
    Dim ret$, place100&
    If n < 1000 Then
        ret = Format(n, "000")
    Else
        place100 = (n - 1000) \ 100
        ret = Format(n - 1000 - 100 * place100, "00") & Chr(65 + place100)
    End If
    MyNo = prefix & ret
End Function


この記事にはVBAのコードが含まれています。

緑の太文字→注釈
茶色の太文字→条件分岐
赤の太文字→ループ
青の太文字→その他

まる2021さま
コードありがとうございます。

年数の「24」は【工事受付表】シートからコピーしますので
B列24を抜いた数字がのみが私がお願いしたい事です。

これを【控】のD列の一番最後から次を自動に取得して番号を
振当てる様にしたいです。

 
【控】の最後の番号が999→取得する番号は00A
【控】の最後の番号が99A→取得する番号は00B


いまのコードはちょっと汚いですが

Sub 番号()

   Sheets("控").Unprotect Password:="***"
   Dim lngSNO As Long
   Dim i As Long
   Dim rowNo工事受付票  As Integer
   Dim rowNo控    As Integer
   Dim d1 As Date
   
   Range("AA2").Value = Date
   
   Dim strDate    As String
   Dim strNo1      As String
   Dim strNo2       As String
   Dim strNo3       As String
   Dim strNo4       As String
   Dim strUketsuke  As String
   Dim strIrai1     As String
   Dim strIrai2     As String
   Dim strKouji1    As String
   Dim strKouji2    As String
   Dim ttrNaiyou    As String
    
    lngSNO = Application.InputBox("開始番号？", Default:=Sheets("控").Range("D65536").End(xlUp) + 1, Type:=1)
    If lngSNO = False Then Exit Sub
   
    With Worksheets("工事受付票")
        For i = lngSNO To lngSNO
        .Range("AD1").Value = Format(i, "000")
                     Title = "シートのコピー"
             IfMsbox = "工事受付票をコピーします。よろしいですか"
              answer = MsgBox(Msg, vbYesNo, Title)
    If answer = 6 Then
        
   strDate = .Range("aa2")
   strNo1 = .Range("aa1")
   strNo2 = .Range("ac1")
   strNo3 = .Range("ad1")
   strNo4 = .Range("ah1")
   strUketsuke = .Range("ad5")
   strIrai1 = .Range("d3")
   strIrai2 = .Range("m3")
   strKouji1 = .Range("t3")
   strKouji2 = .Range("ae3")
   strNaiyou = .Range("d5")
                  
    rowNo控 = Sheets("控").Range("D65536").End(xlUp).Row + 1
                Sheets("控").Activate
              Cells(rowNo控, 1).Value = strDate
              Cells(rowNo控, 2).Value = strNo1
              Cells(rowNo控, 3).Value = strNo2
              Cells(rowNo控, 4).Value = strNo3
              Cells(rowNo控, 5).Value = strNo4
              Cells(rowNo控, 6).Value = strUketsuke
              Cells(rowNo控, 7).Value = strIrai1
              Cells(rowNo控, 8).Value = strIrai2
              Cells(rowNo控, 9).Value = strKouji1
              Cells(rowNo控, 10).Value = strKouji2
              Cells(rowNo控, 11).Value = strNaiyou
    Else
            If answer = 7 Then
          End If
        Exit Sub
    End If

    Next
    End With
    
'工事受付票のコピー
    Sheets("工事受付票").Select
    Sheets("工事受付票").Copy
    Sheets("工事受付票").Select
    Sheets("工事受付票").Name = "コピー"
    Sheets("コピー").Unprotect Password:="***"
    ActiveSheet.Shapes.SelectAll
  Selection.Delete
    
'工事受付票の記入箇所の消去
    Windows("【テスト】工事受付票.xls").Activate
    Sheets("工事受付票").Select
    Range("AA1,AA2,AD1,D3,M3,T3,AE3,D5").Select
    Selection.ClearContents
    Range("AA2").Select
     
'シートの保護
    Sheets("工事受付票").Protect Password:="***"
    Sheets("控").Protect Password:="***"
        
'シートの保存
      Application.DisplayAlerts = False
      Workbooks("工事受付票.xls").Save
      Workbooks("工事受付票.xls").Close
     Application.DisplayAlerts = True
 
End Sub

どの様にしたらよいでしょうか

添削は、勘弁してください。

前回も書きましたが、再掲します。
「A-Z」を使う為、データ型は必然的に「文字列」となります。

「文字列」に「+1」はできないので、
(1)「文字列」＝＞「数値」に変換
(2)変換した「数値」に「+1」して次の数値を求める。
(3)「求まった次の数値」＝＞「文字列」に変換
という作業が必要になります。

以下で
>最後の番号が999→取得する番号は00A
>最後の番号が99A→取得する番号は00B
は取得できるので、応用してください。

Sub sample()
    Dim lastNo As String, nextNo As String
    lastNo = "999"
    nextNo = LongToString(StringToLong(lastNo) + 1)
    MsgBox lastNo & "の次は" & nextNo & "です。"
    lastNo = "99A"
    nextNo = LongToString(StringToLong(lastNo) + 1)
    MsgBox lastNo & "の次は" & nextNo & "です。"
End Sub
'数値＝＞文字列
Function LongToString(n As Long) As String
    Dim ret As String, place100 As Long
    If n < 1000 Then
        ret = Format(n, "000")
    Else
        place100 = (n - 1000) \ 100
        ret = Format(n - 1000 - 100 * place100, "00") & Chr(65 + place100)
    End If
    LongToString = ret
End Function
'文字列＝＞数値
Function StringToLong(s As String) As Long
    Dim ret As Long
    If IsNumeric(s) Then
        ret = CLng(s)
    Else
        ret = (VBA.Asc(VBA.Right(s, 1)) - 65) * 100 + CLng(VBA.Left(s, 2)) + 1000
    End If
    StringToLong = ret
End Function

これ以上、自分からはコメントできません。
これでも、わからなければ、その旨書いて、他の回答者を待ってください。





この記事にはVBAのコードが含まれています。

緑の太文字→注釈
茶色の太文字→条件分岐
赤の太文字→ループ
青の太文字→その他

000〜999→00A〜99A→00B・・・・00Z〜99Z
となる順列の次の3桁の文字列を返す関数です。
上記の範囲に当てはまらない文字列を引数にした場合はERRを返します。

Function GetNextNumber(sNum As String)
    If sNum Like "###" Then
        If sNum = "999" Then
            GetNextNumber = "00A"
        Else
            GetNextNumber = Format(sNum + 1, "000")
        End If
    ElseIf sNum Like "##?" Then
        If sNum = "99Z" Then
            GetNextNumber = "ERR"
        ElseIf sNum Like "99[A-Z]" Then
            GetNextNumber = "00" & Chr(Asc(Right(sNum, 1)) + 1)
        Else
            GetNextNumber = Format(Left(sNum, 2) + 1, "00") & Right(sNum, 1)
        End If
    Else
        GetNextNumber = "ERR"
    End If
End Function

使用例
Sub sample()
    Dim lastNum As String
    lastNum = "998"
    Debug.Print lastNum; "→"; GetNextNumber(lastNum)
    lastNum = "999"
    Debug.Print lastNum; "→"; GetNextNumber(lastNum)
    lastNum = "00A"
    Debug.Print lastNum; "→"; GetNextNumber(lastNum)
    lastNum = "99Y"
    Debug.Print lastNum; "→"; GetNextNumber(lastNum)
    lastNum = "99Z"
    Debug.Print lastNum; "→"; GetNextNumber(lastNum)
    lastNum = "AAA"
    Debug.Print lastNum; "→"; GetNextNumber(lastNum)
End Sub


この記事にはVBAのコードが含まれています。

緑の太文字→注釈
茶色の太文字→条件分岐
赤の太文字→ループ
青の太文字→その他

まる2021さん
hatenaさん
コードをありがとうございます。

まる2021さんのコードにて検証中ですが
MsgBoxで999の次は00Aとでました。
ありがとうございました。

ただこの番号が転記されなくて
「000」となります。

以前は
For i = nextNo To nextNoで入力出来てましたが
【i】で"型が一致しません"とでます。
【i】は	「Dim i As String」で変数宣言してます。

何度もすみません。
どこを直したらいいのか参考でも教えていただけると
たすかります。

ありがとうございました。
なんとか解決できました。
 For i = nextNo To nextNo←無しで解決

またこの件にて番号の取得について違う事が出来るか質問させていただきます。
よろしくお願いします。