mükerrer kayıtları toplama

[asli676]

merhaba;

sorunum şu

a sütunundaki verileri
benzersiz olarak b sütununa almak
ve c sütunundada benzersiz olan verilerin adetleri yazmak
şunun gibi


a sütunu - b sütunu - c sütunu

ahmet ahmet 4
ahmet ayşe 2
ahmet murat 1
ayşe
murat
ayşe
ahmet



bunu makro ile nasıl çözerim yardımlar için şimdiden teşekkür

 

[İhsan Tank]

formül olsa işinizi görmez mi_?

 

[asli676]

formul dosyayı şişiriyor
çok verim var
makro olsa daha iyi

 

[Mahir64]

merhaba;
sorunum şu
a sütunundaki verileri
benzersiz olarak b sütununa almak
ve c sütunundada benzersiz olan verilerin adetleri yazmak
şunun gibi
a sütunu - b sütunu - c sütunu
ahmet ahmet 4
ahmet ayşe 2
ahmet murat 1
ayşe
murat
ayşe
ahmet
bunu makro ile nasıl çözerim yardımlar için şimdiden teşekkür

Merhaba
Bu şekilde deneyin

Option Explicit
Sub BenzersizListele()
Dim S1 As Worksheet, S2 As Worksheet
Dim i As Long, son As Long, son1 As Long, sat As Long
Set S1 = Sheets("Sheet1"): Set S2 = Sheets("Sheet1")
Application.ScreenUpdating = False
son = S1.[a65536].End(3).Row
S2.Range("c2:c65536").ClearContents
S2.Range("c:c").Borders.LineStyle = 0
sat = 1
For i = 3 To son
    If WorksheetFunction.CountIf(S1.Range("a3:a" & i), S1.Cells(i, "a")) = 1 Then
        sat = sat + 1
        S2.Cells(sat, "c") = S1.Cells(i, "a")
    End If
Next i
son1 = S2.[c65536].End(3).Row
For i = 2 To son1
S2.Cells(i, "d") = WorksheetFunction.CountIf(S1.Range("a1:a" & son), S2.Cells(i, "c"))
Next i
Application.ScreenUpdating = True
End Sub

 

[asli676]

çok teşekkürler

 

[Mahir64]

çok teşekkürler

Kodlar alıntı olduğunu yazmayı unutmuşum.
Kolay gelsin
İyi geceler :hey: