otomatik numaralandırma

[karakaban61]

Arkadaşlar bir evrak kayıt programı oluşturmaya çalışıyorum kaydettiğim her evraka TextBox1 de otomatik numara verdiriyorum aşağıdaki kod ile:
Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
'dosya no otomatik yaz
TextBox1.Text = WorksheetFunction.Max(Sheets("VERİ").Range("A1:A65536")) + 1
End Sub

Sorun şuki bir kayıt silindi mı numaralar karışıyor mükerrer kayıtlar oluşur
10 kayıt var ise : ben 5 ve 6 kayıtları sildim mi numaralandırma 9, 10 diye başlıyor oysa ben 11,12 diye devam etmesini istiyorum silinen evrakın dosya numaraları boş kalacak
kayıt silineside numaralandırma son kaldığı yerden devam etsin

 

[Ömer]

Merhaba,

A sütunundaki satır numaralarını hangi kod ile veriyorsunuz.

 

[karakaban61]

Dim Satır As Long, Say As Byte

Satır = Range("A65536").End(3).Row + 1

Cells(Satır, "A") = Satır - 1

ben a sütunundan bağımsız bu işlemi b sütununda yapmak istiyorum a sütünü otomatik indexlemeye devam edecek benim istediğim b sütunu otomatik olarak bir önceki numarasının bir fazlasını alsın ve bunu TextBox1 yazsın ve TextBox1 deki sayı değiştirilemesin

teşekkürler

 

[Emir Hüseyin Çoban]

. . .

Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
'dosya no otomatik yaz
TextBox1.Text = Sheets("veri").[a65536].End(3).Row + 1
End Sub

. . .

 

[Ömer]

Cells(Satır, "A") = Satır - 1

Basit mantıkla; yukarıdaki satırın yerine aşağıdaki gibi yazarsanız, istediğiniz olur.

Cells(Satır, "A") = "=row()-1"

 

[karakaban61]

teşekkürler huseyincoban benim verdiğim formül ile aynı işe yarıyor
teşekkürler ömer dediğin yaptım ama değişen bir şey oymadı

 

[Ömer]

A sütunun başta girdiğiniz değerleride değiştirmeniz gerekir. Eğer uzun olacaksa A2 hücresine,

=satır()-1

yazın ve son alt satıra kadar kopyalayın. Daha sonra kodu çalıştırın ve deneyin.

.

 

[Emir Hüseyin Çoban]

. . .

Merhaba.
Örnek bir dosya ekleyin, üzerinde çalışalım.

. . .

 

[Murat OSMA]

Kayıt butonuna şu kodu ekleyip bir dener misiniz ?
İlk satırda başlık, ilk sütunda da sıra numarası olduğu düşünüyorum.

[SIZE="2"][FONT="Trebuchet MS"]Sub Emre()
    For i = 2 To Range("A65536").End(3).Row
        Cells(i, 1) = i - 1
    Next i
End Sub[/FONT][/SIZE]

 

[karakaban61]

arkadaşlar hazırladığım sayfa üzerinde veriler olduğu için yeni bir örnek oluşturdum a sütunundaki numaralar otomatik artsın index olarak ama b sütundaki dosya numarası her kayıt için sabit olsun aradan kayıt silince değişmesin ve otomatik olarak bir önceki kayıtın bir fazlasını alsın
teşekkürler

 

[Murat OSMA]

Verdiğim kodu kendinize göre uyarlayacaktınız...

Sil butonu kodlarının sonuna şu kodları ilave edin;

[SIZE="2"][FONT="Trebuchet MS"]Dim i As Integer
    For i = 2 To Range("B65536").End(3).Row
        Cells(i, 2) = i - 1
    Next i
    i = Empty[/FONT][/SIZE]

 

[karakaban61]

sanırım tam olarak anlatamadım bu kod aradan bir kayıt silince kayıtları otomatik olarak yeniden numaralandırıyor bütün dosya numaraları değişiyor ben bunu istemiyorum her kayıtın değişmeyen özel bir numarası olsun istiyorum

 

[karakaban61]

yanı b sütünün deki dosya numarası bir önceki numaranın bir fazlası olarak otomatik olarak artması gerekiyor aradan bir kayıt silinse de bir önceki kayıt baz alındığından dosya numaraları değişmemiş olacak

 

[Murat OSMA]

Kusura bakmayın ben anlamadım. Arkadaşlar yardımcı olacaklardır...

İyi akşamlar.

 

[Murat OSMA]

Çıkmadan son bir gayret ettim, ama yine de emin değilim...
TextBox1_Exit olayını şu şekilde bir deneyiniz;

[SIZE="2"][FONT="Trebuchet MS"]Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    TextBox1.Text = Range("B65536").End(3)(1, 1) + 1
End Sub[/FONT][/SIZE]

 

[karakaban61]

Çıkmadan son bir gayret ettim, ama yine de emin değilim...
TextBox1_Exit olayını şu şekilde bir deneyiniz;

[SIZE="2"][FONT="Trebuchet MS"]Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    TextBox1.Text = Range("B65536").End(3)(1, 1) + 1
End Sub[/FONT][/SIZE]

evet süper çok teşekkürler tam istediğim şey buydu
ilginiz için teşekkürler

 

[Murat OSMA]

Şaşırdım !

Rica ederim, iyi akşamlar...