Eğersay

[cemshan]

Merhaba arkadaşlar ;
Çalışma sayfamda aşağıda yazdığım formülü kullanıyorum artık aşırı kasmaya başladı bunu vba yada macro ile nasıl yapabilirim
=EĞERSAY($C$2:C2;C2)&C2

şimdiden teşekkürler

 

[ÖmerFaruk]

Formüllü dosyanızın bir örneğini paylaşır mısınız?

 

[cemshan]

Selam yeniden dosya linki aşağıdadır.

Yukleme_20220811.xlsm dosyasını indir - download

Yukleme_20220811.xlsm dosyasını indir, download. Dosya.tc .Dosya Upload. Dosya Paylaş. Dosya Yükle

s6.dosya.tc

 

[ÖmerFaruk]

Aşağıdaki kodları bir butona atayıp çalıştırabilirsiniz.

Sub Siparisler()
Dim Veri, Siparis As Object
    With Worksheets("Siparişler")
        Set Siparis = VBA.CreateObject("Scripting.Dictionary")
        Veri = .Range("C2:C" & .Range("C" & Rows.Count).End(3).Row).Value
        ReDim Liste(1 To UBound(Veri), 1 To 1)
        For i = LBound(Veri) To UBound(Veri)
            If Not Siparis.Exists(Veri(i, 1)) Then
                Siparis.Add Veri(i, 1), 1
            Else
                Siparis.Item(Veri(i, 1)) = Siparis.Item(Veri(i, 1)) + 1
            End If
            Liste(i, 1) = Siparis.Item(Veri(i, 1)) & Veri(i, 1)
        Next
        .Range("A2").Resize(UBound(Veri, 1)) = Liste
    End With
End Sub

 

[cemshan]

Aşağıdaki kodları bir butona atayıp çalıştırabilirsiniz.

Sub Siparisler()
Dim Veri, Siparis As Object
    With Worksheets("Siparişler")
        Set Siparis = VBA.CreateObject("Scripting.Dictionary")
        Veri = .Range("C2:C" & .Range("C" & Rows.Count).End(3).Row).Value
        ReDim Liste(1 To UBound(Veri), 1 To 1)
        For i = LBound(Veri) To UBound(Veri)
            If Not Siparis.Exists(Veri(i, 1)) Then
                Siparis.Add Veri(i, 1), 1
            Else
                Siparis.Item(Veri(i, 1)) = Siparis.Item(Veri(i, 1)) + 1
            End If
            Liste(i, 1) = Siparis.Item(Veri(i, 1)) & Veri(i, 1)
        Next
        .Range("A2").Resize(UBound(Veri, 1)) = Liste
    End With
End Sub

Elinize sağlık çok teşekkür ederim