değer varsa satır numarası versin

[Hacı Bayram ÖZKAN]

arkadaşlar isteğimi ekli dosyada anlattım, D sütununda eğer değer varsa buna karşılık A sütununda sıra numarası vermesini istiyorum. makro ile hepinize teşekkürler.

 

[Ömer]

Merhaba,

Formül:

A20 hücresine yazarak alt satırlara kopyalayınız.

=EĞER(D20="";"";BAĞ_DEĞ_DOLU_SAY($D$20:D20))

Makro:

Sub SiraNo()
 
    Dim i As Long
 
    For i = 20 To Cells(Rows.Count, "D").End(xlUp).Row
 
        If Cells(i, "D") <> "" Then
            Cells(i, "A") = WorksheetFunction.CountA(Range("D20:D" & i))
        End If
 
    Next i
 
End Sub

.

 

[Korhan Ayhan]

Merhaba,

Alternatif olarak aşağıdaki kodu denermisiniz. Kodu sayfanızın kod bölümüne uygulayınız.

D sütununa değer girdikçe A sütununa sıra numarası otomatik gelir.

Option Explicit
 
Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("D20:D" & Rows.Count)) Is Nothing Then Exit Sub
    Range("A20:A" & Rows.Count).ClearContents
    With Range("A20:A" & Cells(Rows.Count, "D").End(3).Row)
        .Formula = "=IF(D20="""","""",COUNTA(D$20:D20))"
        .Value = .Value
    End With
End Sub

 

[Hacı Bayram ÖZKAN]

teşekkürler üstatlarım. dua ile kalın

 

[Hacı Bayram ÖZKAN]

Ömer bey, güzel olmuş eline sağlık, bir sorun var buna bakarmısın, satır arasından bir değer silince önce çalıştırılan makro tarafından verilen sayı, ikinci bir defa makro çalıştırıldığında yerinde kalıyor, yani ikinci defa makro çalıştırıldığında ilk verilen sayının silinmesi lazım, yani, D25 deki veriye karşılık diyelim ki 5 sıra numarasını verdi, Tekrarında D25 deki değer silinince ikinci defa bu makroyu çalıştırıldığında burada kalan 5'in silinmesi lazım tamam yinede olmuş emeğine sağlık,
Korhan bey sizinki tam çalışıyor, diyeceksiniz ki yukardaki yazı niye alternatif olsun diye her ikinizde dua ile kalın

 

[Hacı Bayram ÖZKAN]

Ömer bey, güzel olmuş eline sağlık, bir sorun var buna bakarmısın, satır arasından bir değer silince önce çalıştırılan makro tarafından verilen sayı, ikinci bir defa makro çalıştırıldığında yerinde kalıyor, yani ikinci defa makro çalıştırıldığında ilk verilen sayının silinmesi lazım, yani, D25 deki veriye karşılık diyelim ki 5 sıra numarasını verdi, Tekrarında D25 deki değer silinince ikinci defa bu makroyu çalıştırıldığında burada kalan 5'in silinmesi lazım tamam yinede olmuş emeğine sağlık,
Korhan bey sizinki tam çalışıyor, diyeceksiniz ki yukardaki yazı niye alternatif olsun diye her ikinizde dua ile kalın

ömer bey araya şu kodu girdim oldum,
Sub SiraNo()
With Sheets(1).Range("a20:a200")
.Value = ""
End With

Dim i As Long

For i = 20 To Cells(Rows.Count, "D").End(xlUp).Row

If Cells(i, "D") <> "" Then
Cells(i, "A") = WorksheetFunction.CountA(Range("D20" & i))
End If

Next i

End Sub

 

[Ömer]

Bu şekilde yazabilirsiniz.

Sub SiraNo()
 
    Dim i As Long
    
    [COLOR=blue]Range("A20:A" & Rows.Count).ClearContents
[/COLOR]    
    For i = 20 To Cells(Rows.Count, "D").End(xlUp).Row
 
        If Cells(i, "D") <> "" Then
            Cells(i, "A") = WorksheetFunction.CountA(Range("D20:D" & i))
        End If
 
    Next i
 
End Sub

.