Hücre Değerine Göre Otomatik Sıra Numarası Verme

[sametguler]

Ekte sunmuş olduğum küçük örnekte;
Eğer Ad ve Soyad alan aynı anda dolu ise
Sıra No alanı Sıra Numarasını 1 den başlayarak otomatik olarak vermesi gerekiyor.
Alt satırlarda Ad ve Soyad alanı boş ise, yada Ad ve Soyad alanından herhangi biri boş ise Sıra Numarası vermeyecek;
Sıra Numarası verilmeyen satırdan sonraki satırlarda Ad ve Soyad alanı dolu ise, Numaralandırmaya devam edecek..
Ayrıca Herhangi bir satırdan Ad ve Soyad alanı silinirse, yada Ad ve Soyad alanından herhangi biri silinirse, silinen satır için Sıra Numarası verilmeyecek ve, Numaralandırma ardışık olarak devam etmesi gerekiyor.

Bu konuda yardımlarınızı rica ediyorum.
Şimdiden hayırlı günler. Saygılarımla...

 

[askm]

Sayfa kod bölümüne aşağıdaki kodları ekleyip deneyin.

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [b2:c65536]) Is Nothing Then Exit Sub
If Cells(Target.Row, 2) <> Empty And Cells(Target.Row, 3) <> Empty Then
    adet = WorksheetFunction.Max(Range("A2:A" & Target.Row))
    Cells(Target.Row, 1) = adet + 1
End If
End Sub

 

[sametguler]

Hocam
Cells(Target.Row, 1) = adet + 1
Bu satırda hata verdi.
Ayrıca 201. satır dahil 201. satıra kadar numaralandırma yapacaktı sadece.

 

[askm]

Kodların başında kod var mı. 65536. Satıra kadar numara verir. 201 olacaksa bu sayıyı 201 yapın.

 

[sametguler]

Örnek dosyada çalışıyor. Fakat sonradan Ad soyad silince, yada satır aralarındaki boş satırlara Ad soyad yazınca numaralandırma otomatik düzelmiyor.

 

[Mdemir63]

Selamlar
Sayın sametguler

askm arkadaşımızın verdiği kodlar istediğiniz gibi çalışıyor.
siz 201. satıra kadar istiyorsanız. kodlarda ki satırı aşağıdaki gibi düzeltebilirsiniz.

If Intersect(Target, [b2:c201]) Is Nothing Then Exit Sub

 

[sametguler]

Sıralamayı düzgün yapmıyor ki. Ayrıca üstlerden silince sıralama düzelmiyor

 

[Mdemir63]

Selamlar
Kod yardımı ile olması şart mı?
Ayrıca Neden B ve C sütunu sadece B veya sadece C sütunu olsa olmaz mı?
Eğer sadece B sütunu için istersen aşağıdaki kodu A2 hücresine kopyala ve A201 e kadar aşağı doğru çek

=EĞER(B2="";"";ALTTOPLAM(3;$B$2:B2)*1)

 

[Mdemir63]

Tekrar merhaba
Sayfanın kod penceresine aşağıdaki kodları uygulayınız


Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [B2:C201]) Is Nothing Then Exit Sub
Dim i As Long, sr As Long
[a2:a65536].ClearContents
For i = 2 To [B201:C201].End(3).Row
If Not Cells(i, 2) = "" And Not Cells(i, 3) = "" Then
sr = sr + 1
Cells(i, 1) = sr
End If
Next
End Sub

 

[sametguler]

komutan63 hocam elinize sağlık. Güzel oldu fakat kişi yanlışlıkla numarayı silse bile yerine gelmiyor.
Ancak başka bir satıra ad soyad girilirse tekrar düzenleme yapıyor.

 

[Mdemir63]

Selamlar
Silinen numaranın b ve c sütunlarındaki verileri tekrar girmek gerekir.
sizin dediğiniz de olabilir ama benim bilgim o kısmına yeterli değil

 

[Korhan Ayhan]

Alternatif;

Private Sub Worksheet_Change(ByVal Target As Range)
    On Error GoTo 10
    Application.EnableEvents = False
    Range("A2:A201").ClearContents
    No = 1
    Select Case Target.Column
        Case 1 To 3
        For X = 2 To 201
            If Cells(X, 2) <> "" And Cells(X, 3) <> "" Then
                Cells(X, 1) = No
                No = No + 1
            End If
        Next
    End Select
10  Application.EnableEvents = True
End Sub

 

[sametguler]

Korhan Hocam;
Ad Soyad alanını boşaltınca numaralandırma düzgün işlemiyor. Üst ve alt satırlar otomatik düzelmesi lazım

 

[Korhan Ayhan]

Koda küçük bir ekleme yaptım. Tekrar deneyiniz.

 

[Mdemir63]

Selamlar
Korhan hocam
sıra no karşısında ki (B ve C sütunlarındaki) bilgileri silince numara kalıyor

Saygılar

 

[Korhan Ayhan]

Kodun son halini tekrar deneyiniz.

 

[sametguler]

Elinize sağlık Korhan Hocam. Çok teşekkür ederim oldu

 

[sametguler]

Peki Sıra Numarası (A19) boş olan 19. hücre ve sonrasında 221. (A221) hücre arası olan satırları tamamen gizlemek için ne yapabiliriz. Bu kodlar olmadan sadece gizlemek için ne yapabiliriz. Bu gizleme anlık olacak. Çünkü Sıra Numaraları başka sayfadan geliyor.
Gizleme Kodları Başka sayfa için kullanılacak.

 

[Korhan Ayhan]

Deneyiniz.

Sub Gizle()
    Range("A19:A221").EntireRow.Hidden = True
End Sub

 

[sametguler]

Korhan hocam butona bağlı olmayacak. Bu konu ile yeni bir konu açtım. Allah razı olsun herkesten.