Aynı degerli olanları 1 den itibaren sıralama

[emin.soydemir]

Merhaba Arkadaslar

B kolonunda aynı olan degerlerin C de aynı ama bir oncekinden bir fazla, D kolonunda karsılıgına 1 den itibaren sayı sıralamsı nasıl yapabilirim.

Tesekkurler

sample hosted at ImgBB

ImgBB üzerinde barındırılan sample görseli

ibb.co

 

[Muzaffer Ali]

Merhaba.
Fotoğraf yerine dosyanızı ekleseniz daha iyi olur, aksi halde dosyayı biz hazırlamak durumunda oluyoruz.

Aşağıdaki kodları deneyin. Olmazsa örnek dosya ekleyin.

Sub Test()
    Dim Bak As Long
    
    For Bak = 2 To Cells(Rows.Count, "B").End(xlUp).Row
        If Cells(Bak, "B") = Cells(Bak - 1, "B") Then
            Cells(Bak, "D") = Cells(Bak - 1, "D") + 1
        Else
            Cells(Bak, "D") = 1
        End If
    Next
End Sub

 

[emin.soydemir]

cok tesekkurler dosya yukleyemedigim icin boyle yaptım. D kolonu 1 den siraliyor simdi. C kolonu eksik kaldi. 201102 olarak aynı yazabilir mi sonra 201103 aynı olan B ler icin

 

[Muzaffer Ali]

Bu durumda kodları çalıştırmadan önce C2 de mutlaka bir rakam olmak zorunda çünkü C2 de yazan rakama göre artı 1 eklemekte.

Sub Test()
    Dim Bak As Long
    
    For Bak = 2 To Cells(Rows.Count, "B").End(xlUp).Row
        If Cells(Bak, "B") = Cells(Bak - 1, "B") Then
            Cells(Bak, "D") = Cells(Bak - 1, "D") + 1
            Cells(Bak, "C") = Cells(Bak - 1, "C")
        Else
            Cells(Bak, "D") = 1
            Cells(Bak, "C") = Cells(Bak - 1, "C") + 1
        End If
    Next
End Sub

Not: Dosya eklemek için dosya.tc gibi bir siteyi kullanabilirsiniz.

 

[emin.soydemir]

calistirdim olmadı malesef type mismatch hatasi aldım.

dediginiz gibi dosyayı ekledim https://s4.dosya.tc/server14/2p4j44/ornek.xlsx.html

 

[emin.soydemir]

selam var mı bir sorun

 

[Muzaffer Ali]

Aşağıdaki kodu deneyin

Sub Test()
    Dim Bak As Long
    
    For Bak = 2 To Cells(Rows.Count, "B").End(xlUp).Row
        If Cells(Bak, "B") = Cells(Bak - 1, "B") Then
            Cells(Bak, "D") = Cells(Bak - 1, "D") + 1
            Cells(Bak, "C") = Cells(Bak - 1, "C")
        Else
            Cells(Bak, "D") = 1
            If Bak > 2 Then Cells(Bak, "C") = Cells(Bak - 1, "C") + 1
        End If
    Next
    MsgBox "İşlem tamamlandı."
End Sub

 

[Korhan Ayhan]

Merhaba,

Formülle alternatifler;

C1;

="2011"&TEXT(SUMPRODUCT(1/COUNTIF(B$2:B2;B$2:B2));"00")

D1;

=COUNTIF(B$2:B2;B2)

 

[emin.soydemir]

cok tesekkur ediyorum hayat kurtardınız. tekrar tekrar tesekkur ederim