• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

özetleyerek saydırma

Katılım
18 Ağustos 2009
Mesajlar
752
Excel Vers. ve Dili
Office Ev ve İş 2021 - Türkçe
Arkadaşlar sayfamda satırlarda bulunan verileri butonla ya da başka bir yöntemle özetleme yaptırarak kaç adet olduklarını saydırmak istiyorum. Bunun için nasıl bir macro ya da komut kullanabilirim?

Teşekkürler...
 

Ekli dosyalar

Merhaba. E2 hücresine =EĞERSAY(A2:A13;D2) formülü yazılabilir.
 
Aşağıdaki kodlar ile yapabilirsiniz. Yalnız örnek dosyanızda 1 rakamını 2 kere alıyor. Nedenini anlayamadım.
Kod:
Private Sub CommandButton1_Click()
Dim sonsat, Son As Long
Range("D2:D65000").ClearContents
sonsat = Range("A" & Rows.Count).End(xlUp).Row
Range("A2:A" & sonsat).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("D2"), Unique:=True
Son = Range("D" & Rows.Count).End(xlUp).Row

For i = 2 To Son
    Cells(i, 5) = WorksheetFunction.CountIf(Range("A2:A" & sonsat), Cells(i, 4))
Next i
MsgBox "İşleminiz tamamlandı...", vbCritical, "ASKM"
End Sub
 
Çok güzel olmuş teşekkürler birde orası çözülürse muhteşem olacak...
 
Yalnız örnek dosyanızda 1 rakamını 2 kere alıyor. Nedenini anlayamadım.

Merhaba,

Çalışmada başlık kullanılmadığı için ilk değeri başlık olarak görüyor. A1 hücresine başlık girip kodları ona göre düzenlerseniz sorun çözülür.

.
 
Ömer üstadın dediği gibi ya başlık ekleyerek yada aşağıdaki kodlar ile çözüm olur.
Kod:
Private Sub CommandButton1_Click()
Dim sonsat, Son As Long
Range("D2:E65000").ClearContents
sonsat = Range("A" & Rows.Count).End(xlUp).Row
'Range("A2:A" & sonsat).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("D2"), Unique:=True
a = 2
For x = 2 To sonsat
   If WorksheetFunction.CountIf(Range("A2:A" & x), Cells(x, 1)) = 1 Then
        Cells(a, 4) = Cells(x, 1)
        a = a + 1
    End If
Next x
    
Son = Range("D" & Rows.Count).End(xlUp).Row
For i = 2 To Son
    Cells(i, 5) = WorksheetFunction.CountIf(Range("A2:A" & sonsat), Cells(i, 4))
Next i
MsgBox "İşleminiz tamamlandı...", vbCritical, "ASKM"
End Sub
 
Geri
Üst