Kaçar tane var

[kratos06]

selam
a sütununda 100 kişinin yaşları var
bunların c sütuna yaşgrubu d sütunada kaç kişi var olduğu gösteren bir makro yazarmısınız teşk.?

Nottomatik süzü defalarca kullanmak zorunda kalıyorum.
bunun kolayını yazarsanız sevinirim.

 

[Mehmet Şahin]

Merhaba,
aşağıdaki kodu denermisiniz, iyi çalışmalar.

Sub grup()
Dim x As Long
Dim s1 As Worksheet
Set s1 = Sheets("Sayfa1")

son1 = s1.[A65536].End(3).Row
w = 1
For x = 2 To s1.[A65536].End(3).Row
        If WorksheetFunction.CountIf(s1.Range("a2:a" & x), s1.Cells(x, "a")) = 1 Then 
        w = w + 1
         s1.Cells(w, "c") = s1.Cells(x, "a")
         s1.Cells(w, "d") = WorksheetFunction.CountIf(s1.Range("a2:a" & son1), s1.Cells(x, "a"))
        End If
Next x
    Set s1 = Nothing

End Sub

 

[kratos06]

artı olarak kaçar tane olanları sıraya dizermisiniz

ellerinize sağlık
sadece ek olarak a sutununda hangisinden kaçar tane var olduğunu bulmuşunuz ancak sırayada yani küçükten büyüğe doğru sıralarsanız çok sevinirim.
istatistik yapacam çok işime yarayacak

 

[Korhan Ayhan]

Selamlar,

Aşağıdaki kodu denermisiniz.

Option Explicit
 
Sub GRUPLANDIR()
    Dim X As Long, Satır As Long
    
    Application.ScreenUpdating = False
    
    Sheets("Sayfa1").Select
    Range("C2:D65536").ClearContents
    Satır = 2
    
    For X = 2 To Range("A65536").End(3).Row
        If WorksheetFunction.CountIf(Range("C:C"), Cells(X, "A")) = 0 Then
            Cells(Satır, "C") = Cells(X, "A")
            Cells(Satır, "D") = WorksheetFunction.CountIf(Range("A:A"), Cells(X, "A"))
            Satır = Satır + 1
        End If
    Next
    
    Range("C:D").Sort Key1:=Range("D2"), Order1:=xlDescending, Header:=xlGuess, _
    OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
 
    Application.ScreenUpdating = True
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[kratos06]

Sırala

Kusura bakmayın ama ben c sütünun küçükten büyüğe doğru sıralanmasını istedim, siz d sütünu büyükten küçüğe doğru sıralamışsınız. Size zahmet olacak
Ayrıca ben D2 yi c2 yapsamda büyükten küçüğe doğru sıraladı tersini yapmasını istiyorum çok teşk.ederim.

 

[Korhan Ayhan]

Selamlar,

Aşağıdaki şekilde denermisiniz.

Option Explicit
 
Sub GRUPLANDIR()
    Dim X As Long, Satır As Long
    
    Application.ScreenUpdating = False
    
    Sheets("Sayfa1").Select
    Range("C2:D65536").ClearContents
    Satır = 2
    
    For X = 2 To Range("A65536").End(3).Row
        If WorksheetFunction.CountIf(Range("C:C"), Cells(X, "A")) = 0 Then
            Cells(Satır, "C") = Cells(X, "A")
            Cells(Satır, "D") = WorksheetFunction.CountIf(Range("A:A"), Cells(X, "A"))
            Satır = Satır + 1
        End If
    Next
    
    Columns("C:D").Sort Key1:=Range("C1"), Order1:=xlAscending, Header:=xlGuess, _
    OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
 
    Application.ScreenUpdating = True
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[kratos06]

çok teşk.ederim ellerinize sağlık çok işime yarayacak