Soru Her Boşluk Olduğunda Sıra Numarasını 1 den Başlatmak

[TURKOLOG]

Herkese Merhaba şöyle bir sıralama kadrosuna ihtiyacım var :
D 16 dan Son dolu D satırına kadar eğer 6 rakam varsa hücrede
J16 dan itibaren sıra numarası vermesi.
Eğer D satırında 6 karakterden az veya D boş ise J satırına sıra numarası vermeyecek .

Daha sonraki gelen D satırında 6 karekter var ise J satırına 1 den başlayarak yeniden sıra numarası verecek. Her boşlukta numara yeniden 1 den başlayacak yani
Yardımcı olabilecek olan varsa çok sevinirim.

 

[TURKOLOG]

Örnek Dosya ekledim. Daha hızlı olması açısından

 

[Tevfik_Kursun]

Merhaba Arkadaş,
Deneyiniz
İyi çalışmalar

 

[Korhan Ayhan]

Formülle alternatif;

J16;

=IF(LEN(D16)<>6;"";IF(AND(D15="";LEN(D16)=6);1;J15+1))

IF = EĞER
AND = VE
LEN = UZUNLUK

 

[TURKOLOG]

Merhaba Arkadaş,
Deneyiniz
İyi çalışmalar

Hocam kod D sütununda 6 karekter yoksa da sıralama yapıyor ama

 

[Tevfik_Kursun]

Benim örnekte doğru çalışıyor. 6 karakterden az ise diye almıştım. sizin dosyayı görmeden hazırlamıştım. Sizin dosyada denemedim.
Makroyu bu makro ile değiştirin.

Sub SiraNo()
    Dim x As Integer
    son = Cells(Rows.Count, "D").End(3).Row
    For x = 1 To son
        If Len(Cells(15 + x, 4)) <> 6 Then
            Cells(15 + x, 10) = ""
          Else
            Cells(15 + x, 10) = 1 + Cells(15 + x - 1, 10)
        End If
    Next x
End Sub

iyi çalışmalar

 

[TURKOLOG]

Benim örnekte doğru çalışıyor. 6 karakterden az ise diye almıştım. sizin dosyayı görmeden hazırlamıştım. Sizin dosyada denemedim.
Makroyu bu makro ile değiştirin.

Sub SiraNo()
    Dim x As Integer
    son = Cells(Rows.Count, "D").End(3).Row
    For x = 1 To son
        If Len(Cells(15 + x, 4)) <> 6 Then
            Cells(15 + x, 10) = ""
          Else
            Cells(15 + x, 10) = 1 + Cells(15 + x - 1, 10)
        End If
    Next x
End Sub

iyi çalışmalar

Hocam çok teşekkür ederim . Kod sorunsuz çalıştı.

 

[Korhan Ayhan]

Böylede olabilir.

Önerdiğim formülü makroya çevirdim...

Option Explicit

Sub Sira_No_Ver()
    Range("J:J").ClearContents
    With Range("J16:J" & Cells(Rows.Count, 4).End(3).Row)
        .Formula = "=IF(LEN(D16)<>6,"""",IF(AND(D15="""",LEN(D16)=6),1,J15+1))"
        .Value = .Value
    End With
End Sub

 

[TURKOLOG]

Böylede olabilir.

Önerdiğim formülü makroya çevirdim...

Option Explicit

Sub Sira_No_Ver()
    Range("J:J").ClearContents
    With Range("J16:J" & Cells(Rows.Count, 4).End(3).Row)
        .Formula = "=IF(LEN(D16)<>6,"""",IF(AND(D15="""",LEN(D16)=6),1,J15+1))"
        .Value = .Value
    End With
End Sub

@Korhan Ayhan Hocam emeğinize sağlık bu kodda sorunsuz çalıştı.