Firma Sayısını Bulma.

[ismail-34]

Excel web ailesine selamlar

merhaba b3-b100 arası tekrarlayabilen metinlerim var.tekrarları hariç tutup sayılmalarını istiyorum.sonuç e1 deki gibi görüntülensin.

örnek ektedir.

herkese iyi günler

 

[xtrkax]

Merhaba, metinler A1'den başlasın sonuçlar D1 e yazılacak:

Sub TekrarlariHariçTutupSay()

    Dim ws As Worksheet
    Dim rng As Range
    Dim dict As Object
    Dim cell As Range
    Dim firma As String
    Dim count As Integer
    
    ' Çalışmak istediğiniz çalışma sayfasını belirtin
    Set ws = ThisWorkbook.Sheets("Sayfa1") ' Sheet1 yerine kullanmak istediğiniz sayfa adını yazın
    
    ' Çalışma sayfasındaki veri aralığını belirtin
    Set rng = ws.Range("A1:A" & ws.Cells(ws.Rows.count, 1).End(xlUp).Row)
    
    ' Bir sözlük (dictionary) nesnesi oluşturun
    Set dict = CreateObject("Scripting.Dictionary")
    
    ' Sözlüğe tekrarlı firmaları ekleyin
    For Each cell In rng
        firma = cell.Value
        If Not dict.exists(firma) Then
            dict(firma) = 1
        End If
    Next cell
    
    ' Sözlükteki firmaların sayısını hesaplayın
    count = dict.count
    
    ' Sonucu D1 hücresine yazdırın
    ws.Range("D1").Value = "Firma Sayısı: " & count
    
End Sub

 

[xtrkax]

Şu formül de iş görür fakat sütun olarak seçmeyin, veri nerede başlıyor nerede bitiyor ise o şekilde seçilmeli:

="Firma_Sayısı:" & (TOPLA.ÇARPIM(1/EĞERSAY(A1:A38;A1:A38)))

 

[Ali]

="Firma Sayısı: " &TOPLA.ÇARPIM((B3:B100<>"")/EĞERSAY(B3:B100;B3:B100&""))

şeklinde yazarsak son hücre adresinden bağımsız çalışır.

 

[ismail-34]

Şu formül de iş görür fakat sütun olarak seçmeyin, veri nerede başlıyor nerede bitiyor ise o şekilde seçilmeli:

="Firma_Sayısı:" & (TOPLA.ÇARPIM(1/EĞERSAY(A1:A38;A1:A38)))

Teşekkürler son hücreyle bağımlı sanırım.

 

[ismail-34]

="Firma Sayısı: " &TOPLA.ÇARPIM((B3:B100<>"")/EĞERSAY(B3:B100;B3:B100&""))

şeklinde yazarsak son hücre adresinden bağımsız çalışır.

bağımsız olması güzel hocam.daha kullanışlı .. teşekkürler.

 

[ismail-34]

Merhaba, metinler A1'den başlasın sonuçlar D1 e yazılacak:

Sub TekrarlariHariçTutupSay()

    Dim ws As Worksheet
    Dim rng As Range
    Dim dict As Object
    Dim cell As Range
    Dim firma As String
    Dim count As Integer
   
    ' Çalışmak istediğiniz çalışma sayfasını belirtin
    Set ws = ThisWorkbook.Sheets("Sayfa1") ' Sheet1 yerine kullanmak istediğiniz sayfa adını yazın
   
    ' Çalışma sayfasındaki veri aralığını belirtin
    Set rng = ws.Range("A1:A" & ws.Cells(ws.Rows.count, 1).End(xlUp).Row)
   
    ' Bir sözlük (dictionary) nesnesi oluşturun
    Set dict = CreateObject("Scripting.Dictionary")
   
    ' Sözlüğe tekrarlı firmaları ekleyin
    For Each cell In rng
        firma = cell.Value
        If Not dict.exists(firma) Then
            dict(firma) = 1
        End If
    Next cell
   
    ' Sözlükteki firmaların sayısını hesaplayın
    count = dict.count
   
    ' Sonucu D1 hücresine yazdırın
    ws.Range("D1").Value = "Firma Sayısı: " & count
   
End Sub

anladım makro butonlu hali.teşekkür ederim.