Tekrarlanan satırların bilgilerini sıralama

[hayalbert]

arkadaşlar selam
işyerindeki tüm vakaları kaydettiğim bir database.xls dosyam var
bazı vakaların zamanla tekrar etmesi muhtemel
bu nedenle yeni kayıt girerken bu vaka ile alakalı ismin daha önce olup olmadığı var ise kaç kere hangi vaka numaraları ile olduğunu bulmam ve tercihen bir listbox içinde göstermem lazım
bu konu ile alakalı örnek tablo ilişik olup koyu renkli vurgulanmış satırları bulmam gerektiğini varsayalım
bu arada bunu otomatik süzle yapmak kuşkusuz mümkün benim amacım makro ile bulup bir sonraki sütünda varsa önceki tekrarı/tekrarları sıralamak bunu da D sütünunda gösterdim
ne önerirsiniz?

 

[leumruk]

Merhaba,

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Intersect(Target, [c2:c65536]) Is Nothing Or Target = "" Then Exit Sub
If WorksheetFunction.CountIf(Range("c2:c" & [c65536].End(3).Row + 1), Target) > 1 Then
Set Aralık = Range("c2:c500")
    Set c = Aralık.Find(Target, LookIn:=xlValues)
    If Not c Is Nothing Then
        firstaddress = c.Address
        Do
        Sat = Sat + 1
            msj = msj & Chr(10) & Cells(c.Row, "a") & " ***** " & Cells(c.Row, "b") & " ***** " & Cells(c.Row, "c")
        Set c = Aralık.FindNext(c)
        Loop While Not c Is Nothing And c.Address <> firstaddress
    End If
    MsgBox msj
End If
End Sub

 

[hayalbert]

.
.
.
mükerer kayıtların ilkini bulup ilgili hücreye yazmayı başardım şimdikaldı sonraki kayıtları da bulmak...

Private Sub CommandButton1_Click()
Sheets("sayfa1").Select
Range("a2").Select
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Select
Loop
ActiveCell.Offset(-1, 0).Select
ActiveCell.AutoFill Destination:=Range(ActiveCell.Address & ":" & ActiveCell.Offset(1, 0).Address), Type:=xlFillDefault
ActiveCell.Offset(1, 0).Select
ActiveCell.Offset(0, 2).Value = TextBox3.Text
b = ActiveCell.Offset(0, 2).Value
satirno = Range("c2:c" & ActiveCell.Row).Find(TextBox3.Text, SearchDirection:=xlNext, MatchCase:=False).Row
If satirno = ActiveCell.Row Then GoTo 10
ActiveCell.Offset(0, 3).Value = Cells(satirno, 1).Text
10:
Unload UserForm1
End Sub

 

[hayalbert]

ilginize çok teşekkür ederim
sonuçları son girilen kaydın yanındaki hücreye ekleyip sonrada bu sonuşları listbox a da aktarabilirsek süper çözüm hem de çok hızlı

 

[leumruk]

Merhaba,
İsteğinize göre basit bir örnek hazırladım. Fikir verecektir.

 

[hayalbert]

bu çözüm gerçekten çok iyi ve çok hızlı, ben arama yavaş olmasın diye kayıt esnasında mükerer olanları bir yere yazmayı planlıyordum. Bu durumda gerek kalmayacak ama verdiğiniz fikri kendi asıl makroma adapte etmem lazım
muhtemelen birkaç şey daha soracağım