Otomatik evrak sıra numarası verme

[msetr]

Herkese iyi geceler.

Excele faturaları giriyorum. Her girdiğim satır için bir kayıt numarası vermesini istiyorum.

Örneğin B sütununa kayıt girince C sütununa birden başlayarak sıradaki numarayı versin. Bu numara azalan artan sıralama yapınca veya filtre uygulayınca değişmesin her zaman sabit kalsın. Referans id kodu gibi.

Forumda aradım Korhan Beyin yazdığı kodu buldum.
Ama sırala filtre yapınca sıra numarası değişiyor.
Birde kod kayıt girince otomatik çalışırsa çok iyi olur.

Yardımcı olacak arkadaşlara şimdiden teşekkürler.

Sub SIRA_NO_VER()
Range("A3:A" & Rows.Count).ClearContents
If Range("B3") <> "" Then
Range("A3") = 1
Range("A3:A" & Cells(Rows.Count, 2).End(3).Row).DataSeries _
Rowcol:=xlColumns, Type:=xlLinear, Date:=xlDay, Step:=1, Trend:=False
End If
End Sub

 

[çıtır]

Doğru anladıysam isteğiniz bu olabilir.:?:
Sayfa kodu olarak kopyalayınız.

Private Sub Worksheet_Change(ByVal Target As Range) 'KAYIT SIRASI VERME
On Error Resume Next
If Intersect(Target, Range("b2:b10000")) Is Nothing Then Exit Sub
If Target = "" Then
Target.Offset(0, 1) = ""
Else
If Target.Offset(0, 1) = "" Then
Target.Offset(0, 1) = WorksheetFunction.Max(Range("c2:c10000")) + 1
End If
End If
End Sub

Kolay gelsin.

 

[msetr]

Cevabınız için teşekkürler. Kod sorunsuz çalışıyor. Şimdiden Ramazan Bayramınız mübarek olsun.

 

[çıtır]

Cevabınız için teşekkürler. Kod sorunsuz çalışıyor. Şimdiden Ramazan Bayramınız mübarek olsun.

Rica ederim.Dönüş yaptığın için teşekkür ederim.Ben de Sizin gelecek Ramazan Bayramınızı tebrik eder.Sağlıklı ve mutluluk içinde geçirmenizi dilerim. ost:

 

[excelience]

merhaba çıtır hocam hayırlı bayramlar bu kodu yazıyorum fakat a ya aktaramıyorum numaralandırmayı sürekli c ye gidiyor yardımcı olabilrimisiniz .şimdiden teşekkürler (DİĞER HOCALARIMIZ DA YARDIMCI OLABİLİRLER)

 

[çıtır]

B de değişiklik olduğunds A da sıra numarası.Hayırlı Bayramalar.

Private Sub Worksheet_Change(ByVal Target As Range) 'KAYIT SIRASI VERME
On Error Resume Next
If Intersect(Target, Range("b2:b10000")) Is Nothing Then Exit Sub
If Target = "" Then
Target.Offset(0, -1) = ""
Else
If Target.Offset(0, -1) = "" Then
Target.Offset(0, -1) = WorksheetFunction.Max(Range("a2:a10000")) + 1
End If
End If
End Sub

 

[excelience]

TEŞEKKÜRLER HOCAM FAKAT BU SEFERDE BU İKİ KOD ÇAKIŞIYOR NEDEN ACABA
AMBIGUOUS NAME DETECTED:WORKSHEET_CHANGE HATASI
Private Sub Worksheet_Change(ByVal Target As Range) 'KAYIT SIRASI VERME
On Error Resume Next
If Intersect(Target, Range("b2:b10000")) Is Nothing Then Exit Sub
If Target = "" Then
Target.Offset(0, -1) = ""
Else
If Target.Offset(0, -1) = "" Then
Target.Offset(0, -1) = WorksheetFunction.Max(Range("a5:a10000")) + 1
End If
End If
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, [F1:F65536]) Is Nothing Then Cells(Target.Row, "B") = Format(Now, "dd")
If Not Intersect(Target, [F1:F65536]) Is Nothing Then Cells(Target.Row, "C") = Format(Now, "MMMM")
If Not Intersect(Target, [F1:F65536]) Is Nothing Then Cells(Target.Row, "D") = Format(Now, "yyyy")
End Sub

 

[çıtır]

Private Sub Worksheet_Change(ByVal Target As Range) 'KAYIT SIRASI VERME
On Error Resume Next
If Intersect(Target, Range("F5:F10000")) Is Nothing Then Exit Sub
If Target = "" Then
Target.Offset(0, -5) = ""
Target.Offset(0, -4) = ""
Target.Offset(0, -3) = ""
Target.Offset(0, -2) = ""
Else
Target.Offset(0, -5) = WorksheetFunction.Max(Range("a2:a10000")) + 1
Target.Offset(0, -4) = Format(Now, "dd")
Target.Offset(0, -3) = Format(Now, "MMMM")
Target.Offset(0, -2) = Format(Now, "yyyy")
End If
End Sub

 

[rabbace]

Merhaba,

Ben Excel'de sipariş numarası vermek istiyorum ve numara her yeni siparişte otomatik olarak artmalı.

Örneğin:

M00000000001
M00000000002
M00000000003
M00000000004
.
.
.
.
.
M00000000010
M00000000011
M00000000012
.
.
.
.
M00000000099
M00000000100

gibi olmalı ve karakter sayısı 12 olmalı. Formülle ya da makro ile nasıl yapabilirim?