Kaç adet olduğunu hesaplama

[eataer]

Merhaba Arkadaşlar Ceptelefonu satan bir mağazada çalışıyorum bir rapor çıkarmak istiyorum kullandığımız kasa programı satılan tüm cep telefonlarını excell olarak çıkartıyor ben bu tabloya bir formül eklemek istiyorum

örneğin çıkan raporda aşağıdaki satışlar gözüküyor
SM-G935F S7 EDGE GOLD
SM-G935F S7 EDGE GOLD
SM-G935F S7 EDGE GOLD
Iphone 6s Plus 16 gb
Iphone 6s Plus 16 gb
Iphone 6s Plus 16 gb
Iphone 6s Plus 16 gb

formül aşağıdaki gibi hesaplayacak

Samsung S7 EDGE : 3
Iphone 6s Plus 16gb : 4

adet satılmış


teşekkürler & iyi çalışmalar

 

[Orion1]

Dosyanız ektedir.

Sub benzersiz59()
Dim z As Object, sonsat As Long, liste(), i As Long
sonsat = Cells(Rows.Count, "A").End(xlUp).Row
Range("C2:D" & Rows.Count).ClearContents
liste = Range("A1:A" & sonsat).Value
Set z = CreateObject("scripting.dictionary")
For i = 1 To UBound(liste)
    If Not z.exists(liste(i, 1)) Then
        z.Add liste(i, 1), 1
    Else
        z.Item(liste(i, 1)) = z.Item(liste(i, 1)) + 1
    End If
Next i
Application.ScreenUpdating = False
Range("C2").Resize(z.Count, 2) = Application.Transpose(Array(z.keys, z.items))
Application.ScreenUpdating = True
MsgBox "İşlem tamamlandı." & vbLf & "evrengizlen@hotmail.com"
End Sub

 

[bzace]

Merhaba,
Veriler A sütunu iinci satırdan başladığı düşünülmüştür.
B1 hücresine 0 sayısını yazınız.
B2 hücresine;

=EĞERHATA(ARA(;-1/EYOKSA(KAÇINCI(A$2:A$38;B$1:B1;));A$2:A$38);"")

C2 hücresine;

=EĞERSAY(A$2:A$38;B2)

Formülleri gerektiği kadar aşağı çoğaltınız.

Saygılar,
Wuic

 

[eataer]

Dosyanız ektedir.

Sub benzersiz59()
Dim z As Object, sonsat As Long, liste(), i As Long
sonsat = Cells(Rows.Count, "A").End(xlUp).Row
Range("C2:D" & Rows.Count).ClearContents
liste = Range("A1:A" & sonsat).Value
Set z = CreateObject("scripting.dictionary")
For i = 1 To UBound(liste)
    If Not z.exists(liste(i, 1)) Then
        z.Add liste(i, 1), 1
    Else
        z.Item(liste(i, 1)) = z.Item(liste(i, 1)) + 1
    End If
Next i
Application.ScreenUpdating = False
Range("C2").Resize(z.Count, 2) = Application.Transpose(Array(z.keys, z.items))
Application.ScreenUpdating = True
MsgBox "İşlem tamamlandı." & vbLf & "evrengizlen@hotmail.com"
End Sub

Bu işimi gördü çok teşekkür ederim ancak öğrenmek ve geliştirmek adına bunu excel formülleriyle yapılışını görebilirmiyim

 

[eataer]

Merhaba,
Veriler A sütunu iinci satırdan başladığı düşünülmüştür.
B1 hücresine 0 sayısını yazınız.
B2 hücresine;

=EĞERHATA(ARA(;-1/EYOKSA(KAÇINCI(A$2:A$38;B$1:B1;));A$2:A$38);"")

C2 hücresine;

=EĞERSAY(A$2:A$38;B2)

Formülleri gerektiği kadar aşağı çoğaltınız.

Saygılar,
Wuic

Deniyorum teşekkürler

 

[eataer]

tam olarak yapmak istediğimi ekte belirttim ilginiz için teşekkür ederim