Otomatik Sayı numarası verdirme.

[May0663]

Merhabalar,
2020-001-01
2020-001-02
2020-001-03
2020-001-04
2020-001-05
2020-001-06
2020-001-07
2020-001-08
2020-001-09
2020-001-10
10 dan sonra
2020-002-01 diye başlayıp sonsuza kadar devam edecek makroya ihtiyacım var. Yanlız yeni kayıt eklediğimde Refakatçı koşul kısmı seçili olunca
Örneğin hastayı 2020-001-05 diye kayıt ettik
Refakatçiyi kayıt edeceğimiz zaman 2020-001-05-R1

eğer ikincibir refakatçisi var 2020-001-05-R2
diye refakatçide en fazla 10-15 kişi şeklinde bir makroya ihtiyacım var, şimdiden çok teşekkür ederim.

 

[Asri]

Bu konudaki 6. mesajı numarator fonksiyonunu inceleyebilirsiniz.

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

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 =...

excel.web.tr

 

[May0663]

Asri bey merhabalar, öncelikle teşekkür ederim lakin benim istediğim bu değil, bu söylediğiniz toplu atıyor ben bir bir gelen hastalar işin verip istatistiğe kayıt etmesi için istemiştim.

 

[Asri]

Asri bey merhabalar, öncelikle teşekkür ederim lakin benim istediğim bu değil, bu söylediğiniz toplu atıyor ben bir bir gelen hastalar işin verip istatistiğe kayıt etmesi için istemiştim.

Bir defa çalıştırırsanız bir defa artar.
Döngü örnek olması içindi.

 

[May0663]

Denedim maalesef olmuyor. Anlamadım nerde hata yaptığımı ?

 

[May0663]

Bir defa çalıştırırsanız bir defa artar.
Döngü örnek olması içindi.

Denedim maalesef olmuyor. Anlamadım nerde hata yaptığımı ?

 

[Asri]

Bu şekilde deneyebilirsiniz.

HastaNumarator.xlsm

1 file sent via WeTransfer, the simplest way to send your files around the world

we.tl

'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 = ".-/R"

'sayılar 01 aktif edililir ise ikili sayı sisteminde oluşturur
'Const sayilar As String = "01"

Sub hastakayit()
    gec = Range("G13").Value
    sonu = Right(gec, Len(gec) - InStrRev(gec, "-"))
    basi = Left(gec, InStrRev(gec, "-"))
    If sonu = "10" Then
       numarastr = basi & "99"
       Range("G13").Value = numarator(numarastr)
       Range("G13").Value = numarator(Range("G13").Value)
    Else
       numarastr = gec
       Range("G13").Value = numarator(numarastr)
    End If    
End Sub

Sub refakatcikayit()
    Range("I13").Value = numarator(Range("I13").Value)
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

 

[Asri]

Yeni farkettim. Gönderdiğim dosya ve kod 2020-001-99 dan sonra 2020-002-00 oluyor.
Siz 2020-001-10 dan sonra 2020-002-01 olmasını istemişsiniz.

Dosya değil ancak kod bu şekilde düzenlendi.

 

[May0663]

Yeni farkettim. Gönderdiğim dosya ve kod 2020-001-99 dan sonra 2020-002-00 oluyor.
Siz 2020-001-10 dan sonra 2020-002-01 olmasını istemişsiniz.

Dosya değil ancak kod bu şekilde düzenlendi.

Hocam Ellerinize sağlık elleriniz dert görmesin inşAllah saygı ve hürmetlerimi sunarım