VBA benzersizleri bulup sayma

[May0663]

Değerli üstatlarım Merhabalar;
elimde 2 sayfadan oluşan excel sayfası var 1.sayfası veriler 2.sayfa ise istatistikler bunları vba'ada kullanmam mümkün mü ? yardımlarınızı rica ediyorum.
Şimdiden çok teşekkür ederim.

 

[maliex]

merhaba,

"vba'ada kullanmam mümkün mü ? " derken neyi kastettiğinizi anlayamadım ? istatisk sayfasındaki gibi sonuçmu döndürmesini istiyorsunuz ?

 

[May0663]

merhaba,

"vba'ada kullanmam mümkün mü ? " derken neyi kastettiğinizi anlayamadım ? istatisk sayfasındaki gibi sonuçmu döndürmesini istiyorsunuz ?

evet vba kodları gerekiyor

 

[maliex]

farklı bişi denemek istedim umarım işinizi görür

Sub TEST()


Dim s1 As Worksheet
Dim s2 As Worksheet

Set s1 = Sheets("veriler")
Set s2 = Sheets("istatistik")

s2.Range("A1:B100000").Clear

For x = 1 To 5 Step 2
    SS1 = s1.Cells(s1.Rows.Count, x).End(3).Row
    ss2 = s2.Cells(s2.Rows.Count, 1).End(3).Row
    s1.Range(s1.Cells(2, x), s1.Cells(SS1, x)).Copy Destination:=s2.Cells(ss2 + 1, 1)
    ss3 = s2.Cells(s2.Rows.Count, 1).End(3).Row
    s2.Range(s2.Cells(ss2 + 1, 1), s2.Cells(ss3, 1)).RemoveDuplicates Columns:=Array(1), Header:=xlNo
    ss4 = s2.Cells(s2.Rows.Count, 1).End(3).Row
    s2.Cells(ss4 + 1, 1) = "toplam"

Next x

ss4 = s2.Cells(s2.Rows.Count, 1).End(3).Row

With WorksheetFunction


toplamx = 0
For q = 2 To ss4
    s2.Cells(q, 2) = .CountIf(s1.Range(s1.Cells(1, 1), s1.Cells(100000, 1)), s2.Cells(q, 1)) + .CountIf(s1.Range(s1.Cells(1, 3), s1.Cells(100000, 3)), s2.Cells(q, 1)) + .CountIf(s1.Range(s1.Cells(1, 5), s1.Cells(100000, 5)), s2.Cells(q, 1))
    toplamx = s2.Cells(q, 2) + toplamx
    If s2.Cells(q, 1) = "toplam" Then
        s2.Cells(q, 2) = toplamx
        toplamx = 0
        Range(s2.Cells(q, 1), s2.Cells(q, 2)).Interior.Color = RGB(255, 255, 0)
        Range(s2.Cells(q, 1), s2.Cells(q, 2)).Font.Bold = True

    End If

Next q


End With


End Sub

 

[May0663]

farklı bişi denemek istedim umarım işinizi görür

Sub TEST()


Dim s1 As Worksheet
Dim s2 As Worksheet

Set s1 = Sheets("veriler")
Set s2 = Sheets("istatistik")

s2.Range("A1:B100000").Clear

For x = 1 To 5 Step 2
    SS1 = s1.Cells(s1.Rows.Count, x).End(3).Row
    ss2 = s2.Cells(s2.Rows.Count, 1).End(3).Row
    s1.Range(s1.Cells(2, x), s1.Cells(SS1, x)).Copy Destination:=s2.Cells(ss2 + 1, 1)
    ss3 = s2.Cells(s2.Rows.Count, 1).End(3).Row
    s2.Range(s2.Cells(ss2 + 1, 1), s2.Cells(ss3, 1)).RemoveDuplicates Columns:=Array(1), Header:=xlNo
    ss4 = s2.Cells(s2.Rows.Count, 1).End(3).Row
    s2.Cells(ss4 + 1, 1) = "toplam"

Next x

ss4 = s2.Cells(s2.Rows.Count, 1).End(3).Row

With WorksheetFunction


toplamx = 0
For q = 2 To ss4
    s2.Cells(q, 2) = .CountIf(s1.Range(s1.Cells(1, 1), s1.Cells(100000, 1)), s2.Cells(q, 1)) + .CountIf(s1.Range(s1.Cells(1, 3), s1.Cells(100000, 3)), s2.Cells(q, 1)) + .CountIf(s1.Range(s1.Cells(1, 5), s1.Cells(100000, 5)), s2.Cells(q, 1))
    toplamx = s2.Cells(q, 2) + toplamx
    If s2.Cells(q, 1) = "toplam" Then
        s2.Cells(q, 2) = toplamx
        toplamx = 0
        Range(s2.Cells(q, 1), s2.Cells(q, 2)).Interior.Color = RGB(255, 255, 0)
        Range(s2.Cells(q, 1), s2.Cells(q, 2)).Font.Bold = True

    End If

Next q


End With


End Sub

çok teşekkür ederim gerçekten işime çok yaradı dualarımdasınız.