Soru Mükerrer (tekrar eden) veri bilgilerini görmek

[wezyr]

30.000 satırlık bir veri tablomuzda a sütununda çalışanın yaptığı bir hata sonucu tekrar eden sicil numarları ve farklı veri girişleri var. Bunları mevcut veri setini bozmadan sadece mükerrer olanların yerlerini tespit etmek ve o satırdaki verileri bir yerde görmek istiyoruz. Makro yada formülle nasıl yapabiliriz. Örnek dosya ektedir.

 

[Ziynettin]

Makrolu çözüm.

 

[Korhan Ayhan]

Alternatif;

Tüm veriler listeleniyor.

 

[wezyr]

Makrolu çözüm.

Çok teşekkürler. Bu şekliyle çalıştı. Veri sayfasındaki sütun saysını A:C değilde A:J olarak değiştirmek istersek makroda nereleri değiştimem gerekli yapmaya çalıştım debuga düştü.

Dim Veri(), son As Long, v As Worksheet
Private Sub Worksheet_Activate()
    Set v = Sheets("veri")
    son = v.Cells(Rows.Count, 1).End(3).Row
    If son > 1 Then
        Veri = v.Range("A1:C" & son).Value
        Set dc = CreateObject("scripting.dictionary")
        Set dc1 = CreateObject("scripting.dictionary")
            For i = 2 To UBound(Veri)
                dc1(Veri(i, 1)) = dc1(Veri(i, 1)) + 1
                If dc1(Veri(i, 1)) > 1 Then
                    dc(Veri(i, 1)) = ""
                End If
            Next i
        Range("A1").Validation.Delete
        If dc.Count > 0 Then
        Range("A1").Validation.Add xlValidateList, Formula1:=Join(dc.keys, ",")
        End If
    End If
End Sub


Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address(0, 0) = "A1" Then
        If Target <> "" Then
            aranan = Target.Text
            ReDim b(1 To UBound(Veri), 1 To 5)
            For i = 2 To UBound(Veri)
                If CStr(Veri(i, 1)) = aranan Then
                    say = say + 1
                    b(say, 1) = say
                    b(say, 2) = "A" & i
                    b(say, 3) = Veri(i, 1)
                    b(say, 4) = Veri(i, 2)
                    b(say, 5) = Veri(i, 3)
                End If
            Next i
        ss = Cells(Rows.Count, 1).End(3).Row
        If ss > 1 Then
            Range("A2:E" & ss) = Empty
            Range("A2:E" & ss).ClearFormats
        End If
        Range("A2:E" & Rows.Count) = Empty
        If say > 0 Then
            [A2].Resize(say, 5) = b
            [A2].Resize(say, 5).Borders.Weight = xlThin
        End If
    End If
    End If
End Sub

 

[wezyr]

Alternatif;

Tüm veriler listeleniyor.

Çok teşekkürler Korhan hocam.