İD nin belli bir sayıdan ya da harften başlaması

[meleklerim]

Arkadaşlar hepinizin bildiği gibi aşağıda yazdığımız kodla A sütununa 1 den başlayarak benzersiz bir kayıt numarası (ID) getirebiliyoruz.

Private Sub Kaydet_Click()
Dim sonsatır, ID As Integer
sonsatır = WorksheetFunction.CountA(Worksheets("Ana").Range("A:A")) + 1
ID = WorksheetFunction.Max(Worksheets("Ana").Range("A:A")) + 1

Benim sorum bu ID lerin 1 yerine "100000" den ya da atıyorum "XBF" gibi bir koddan başlamasını istersek nasıl yapıyoruz?
100001-100002-100003 ya da XBF1-XBF2-XBF3 gibi artmasını istiyorum

 

[veyselemre]

Private Sub Kaydet_Click()
    Dim id As Long

    With Worksheets("Ana").Cells(Rows.Count, 1).End(3)
        If InStr(.Value, "XBF") Then
            id = Val(Replace(.Value, "XBF", "")) + 1
        Else
            id = 1
        End If
        With .Offset(1)
            .Value = "XBF" & id
            .Offset(, 1) = "B Sütununa yazılacak değer"
            .Offset(, 2) = "C Sütununa yazılacak değer"
        End With
    End With

End Sub

 

[meleklerim]

harikasınız teşekkürler Harf kodları sorunsuz, ancak sayı kodlarında şöyle istemediğim bir durum oluşuyor
100001, 100002 diye gidiyor ancak 10. kayıtta 1000010 yapıyor (doğal olarak birleştirme yaptığı için)
Halbuki ben 100010 olmasını hayal ediyordum. aynışey 100. kayıtta 1000 vb. olacak
ID nin 100 binden başlayarak hep 6 basamaklı olması sağlanabilir mi?

 

[veyselemre]

Private Sub Kaydet_Click()
    Dim id As Long

    With Worksheets("Ana").Cells(Rows.Count, 1).End(3)
        If .Row = 1 Then
            id = 100000
        Else
            id = Val(.Value) + 1
        End If
        With .Offset(1)
            .Value = id
            .Offset(, 1) = "B Sütununa yazılacak değer"
            .Offset(, 2) = "C Sütununa yazılacak değer"
        End With
    End With

End Sub

 

[meleklerim]

tam istediğim gibi çalışıyor, teşekkürler

 

[Asri]

Alternatif;

Kendi geliştirdiğim ve projelerimde kullandığım çok fonksiyonlu numarator

'asriakdeniz@gmail.com - www.asriakdeniz.com
Dim veri() As String
Dim adet As Long
Dim elde, bakilansayi As Boolean

'Arttırılacak harfler
Const harfler As String = "ABCDEFGĞHIİJKLMNOÖPRSŞTUÜXWVYZ"

'Arttırılacak sayılar.
Const sayilar As String = "0123456789"

'Artışa dahil olmayan karakterler
Const dahildegil As String = ".-/"

'sayılar 01 aktif edililir ise ikili sayı sisteminde oluşturur
'Const sayilar As String = "01"
  
Sub deneme()
   Range("A:A").Clear
   'numarastr = "0-0-0-0-1"
   'numarastr = "0-000-1"
   'numarastr = "XBF-0001"
   'numarastr = "____A"
   numarastr = "Seri/000"
  
   For Z = 1 To 100
     numarastr = numarator(numarastr)
     Cells(Z, 1).Value = "'" & numarastr
   Next Z
  
End Sub

Function numarator(numara) As String
   numara = StrReverse(numara)
   adet = Len(numara)
   ReDim Preserve veri(1 To adet)
   For i = 1 To adet
      veri(i) = Mid(numara, i, 1)
   Next i
  
   elde = False
   For j = LBound(veri) To UBound(veri)
      harf = veri(j)
      If InStr(dahildegil, harf) > 0 Then GoTo son
      bakilansayi = sayimi(harf)
      If bakilansayi Then
         veri(j) = sayiarttir(harf)
      Else
         veri(j) = harfarttir(harf)
      End If
      
      If elde = False Then
        Exit For
      End If
son:
   Next j
        
   For i = LBound(veri) To UBound(veri)
      veristr = veristr & veri(i)
   Next i
  
   veristr = StrReverse(veristr)
   If Left(veristr, 1) = Left(sayilar, 1) And elde Then
      numarator = "1" & veristr
   ElseIf Left(veristr, 1) = Left(harfler, 1) And elde Then
      numarator = Left(harfler, 1) & veristr
   Else
      numarator = veristr
   End If
End Function

Function harfarttir(harfstr) As String
    mevcutsira = InStr(harfler, harfstr)
    yenisira = Mid(harfler, mevcutsira + 1, 1)
    If yenisira = "" Then
       harfarttir = Mid(harfler, 1, 1)
       elde = True
    Else
       harfarttir = yenisira
       elde = False
    End If
End Function

Function sayiarttir(sayistr) As String
    mevcutsira = InStr(sayilar, sayistr)
    yenisira = Mid(sayilar, mevcutsira + 1, 1)
    If yenisira = "" Then
       sayiarttir = Mid(sayilar, 1, 1)
       elde = True
    Else
       sayiarttir = yenisira
       elde = False
    End If
End Function


Function sayimi(sadecesayistr)
  liste = "0123456789"
  For k = 1 To Len(sadecesayistr)
    harf = Mid(sadecesayistr, k, 1)
    If InStr(liste, harf) = 0 Then
       sayimi = False
       Exit Function
    End If
  Next k
  sayimi = True
End Function