Karışık numaratör, numara arttırıcı fonksiyonu

Katılım
24 Nisan 2005
Mesajlar
3,653
Excel Vers. ve Dili
Office 2016 EN 64 Bit
Altın Üyelik Bitiş Tarihi
25/05/2022
Yazacağım bir program için numaratöre ihtiyacım oldu. Aşağıdaki şekilde bir fonksiyon yazdım.
sayılar ve harfler karışık numarayı numaratör olarak kullanabilirsiniz.

Harfler ve sayilar metin değişkenlerinin içeriklerini istediğiniz formata göre değiştirebilirsiniz.
Numaratör arttırma işlemi yapılırken bu listelerdeki sıralama dikkate alınarak yapılmaktadır.
Bu neden ile bu listelerdeki Türkçe karakterleri yada İngilizce karakterlri çıkararak numaratörü sınırlayabilirsiniz.

Public Const sayilar As String = "02468" sayilar değişkenini bu şekilde tanımladığınızda iki şer sayan bir numaratör olacaktır

Örneğin;
A1C2D8 gibi bir metni 4 defa işleme aldığınızda , aşağıdaki sonuç çıkacaktır
A1C2D9
A1C2E0
A1C2D1
A1C2D2

Sadece sayı, yada sadece harf içerikli numaratör olarak da kullanabilirsiniz.
1000
1001
1002

ABCD
ABCE
ABCF

Bu yazdığım numaratör sınırsızdır. Yani en azından bir string değişkenin sınırları kadar :)
sayilar ve karakterleri değiştirerek farklı numaratör seçenekleri oluşturabilir siniz.

Gelitirmeye açık, umarım birilerinin işine yarar.


Kod:
Dim veri() As String
Dim adet As Long
Dim elde, bakilansayi As Boolean
Const harfler As String = "ABCDEFGĞHIİJKLMNOÖPRSŞTUÜXWVYZ"
Const sayilar As String = "0123456789"
'Const sayilar As String = "01"
Const dahildegil As String = ".-/"
   
   
Sub deneme()
   Range("A:A").Clear
   numarastr = "0-0-0-0-1"
   
   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
 
Son düzenleme:
Katılım
24 Nisan 2005
Mesajlar
3,653
Excel Vers. ve Dili
Office 2016 EN 64 Bit
Altın Üyelik Bitiş Tarihi
25/05/2022
Güncelleme;

Fonksiyona artışa dahil olmayacak karakter seçimi eklendi.
0-0-0-9 gibi bir numara belirlendiğinde.

Numarator bunu aşağıdaki şekilde arttıracaktır.

0-0-1-0
0-0-1-1
0-0-1-2
.
9-9-9-9

* Farkında olmadan aslında numaratör ile beraber aynı zamanda bir kombinasyon fonksiyonu da yazmışım :)

Sayılar verisini aşağıdaki şekilde tanımlayıp.

Const sayilar As String = "01"

numaraya "00001" verdiğinizde
0 ve 1 in kombinasyonunu yapmaktadır.
Aslında bu fonksiyonun tam olarak neler yapabileceğini test edemedim. :)
 
Üst