kaç aranmış

[a_self_lion]

Selam arkadaşlar sayfa 1 A sutununda sıralı telefon nolarının kaçar kez arandıklarını sayfa 2 de A sutuna benzersizlerini yazmak (yani sayfa 1 de a sutununda 5225141 nolu telefon alt alta 10 defa yazılmış olabilir ben bunu sayfa 2 de 5225141 10 kez aranmış şeklinde nasıl yapabilirim. örnek olsun diye dosyamı ekliyorum

 

[hamitcan]

Eki inceleyin.Yalnız kontrol etmedim.

 

[veyselemre]

2 alternatif

Sub Indexle1()
    Set s1 = Sheets("Sayfa1")
    Set s2 = Sheets("Sayfa2")
    s2.[A2:B65536].ClearContents

    s1.Select
    son = [a65536].End(3).Row
    sat = 1
    For x = 2 To son
        say = WorksheetFunction.CountIf(Range("a2:a" & x), Cells(x, 1))
        If say = 1 Then
            sat = sat + 1
            s2.Cells(sat, 1) = Cells(x, 1)
        End If
    Next x
    
    With s2.Range("b2:b" & s2.[a65536].End(3).Row)
        .Formula = "=COUNTIF(Sayfa1!A2:A" & son & ",Sayfa2!A2)"
        .Value = .Value
    End With
End Sub

Sub Indexle2()
    Application.ScreenUpdating = False
    Sheets("sayfa2").Select
    [A2:B65536].ClearContents

    a = WorksheetFunction.Transpose(Sheets("sayfa1").Range("a2:a" & Sheets("sayfa1").[a65536].End(3).Row).Value)

    Set dic = CreateObject("Scripting.Dictionary")
    dic.CompareMode = TextCompare

    For Each tel In a
        If dic.Exists(tel) Then
            w = dic(tel)
            dic(tel) = w + 1
        Else
            w = 1
            dic.Add tel, w
        End If
    Next

    dizi = WorksheetFunction.Transpose(dic.keys)
    [a2].Resize(UBound(dizi)) = dizi
    dizi = WorksheetFunction.Transpose(dic.items)
    [b2].Resize(UBound(dizi)) = dizi

    Erase a
    Set dic = Nothing
    Application.ScreenUpdating = True
End Sub

 

[Ferhat Pazarçevirdi]

3.Alternatide benden olsun

Sub kackez()
Set sh1 = Sheets("Sayfa1")
Set sh2 = Sheets("Sayfa2")
sh2.Columns("A:B").ClearContents
son1 = sh1.Cells(65536, 1).End(xlUp).Row
sh2.Cells(1, 1) = "TelNo"
For i = 2 To son1
  son2 = sh2.Cells(65536, 1).End(xlUp).Row
  x = Application.WorksheetFunction.CountIf(sh1.Range("A2:A" & i), sh1.Range("A" & i).Value)
  If x = 1 Then
    sh2.Cells(son2 + 1, 1) = sh1.Range("A" & i).Value
    sh2.Cells(son2 + 1, 2) = Application.WorksheetFunction.CountIf(sh1.Range("A2:A" & son1), sh2.Cells(son2 + 1, 1))
  End If
Next i
Set sh1 = Nothing
Set sh2 = Nothing
End Sub

 

[Korhan Ayhan]

Selamlar,

Bir alternatifte ben sunmak isterim. Bu tür işlemlerde eğer ihtiyacınızı karşılıyorsa ÖZET TABLO kullanmak en iyisidir. Ekteki örnek dosyayı incelermisiniz.

 

[altanson]

arkadaşlar bunu formülle yapabilirmiyiz?

belirli bir aralıktaki farklı verileri hangi formülle nasıl buluruz?

 

[N.Ziya Hiçdurmaz]

yanıt

Sub test()
Set s1 = Sheets("Sayfa1")
Set s2 = Sheets("Sayfa2")
For sut = s1.[a65536].End(3).Row To 2 Step -1
If WorksheetFunction.CountIf(s1.Range("a1:a" & sut), s1.Range("a" & sut)) = 1 Then
s1.Range("a" & sut).Copy
s = s + 1
s2.Range("a" & s + 1).PasteSpecial
End If
Next
For sut1 = 2 To [a65536].End(3).Row
s2.Range("b" & sut1) = WorksheetFunction.CountIf(s1.[a2:a5000], s2.Range("a" & sut1))
Next
End Sub

 

[a_self_lion]

Arkadaşlar Hepinize sonsuz kere teşekkürler