tekrarlanan benzersizleri getirmek istiyorum

[othara]

üstatlarım b sutununa 1-99 akada rolan sayfalardaki c sutunundaki tank isimlerini benzersiz girmesini nasıl saglarım .yani bir tank iki kez girilmişşse buraya birinin isimini ver hangi firma oldugunu getirmek istiyorum.Yarıdmlarınız için teşekkür ederim

dosyam ektedir

 

[othara]

İndir benzersiz saydırma xls

Dosyayı indir benzersiz saydırma xls

dosya.co

dosyam ektedir

 

[Korhan Ayhan]

Bu işlem için makro kullanmanız daha uygun ve pratik olacaktır.

 

[othara]

tablomu bozmasın ama

 

[Korhan Ayhan]

Bozulacak bir durum yok. Kodlar zaten dosyaya göre yazılıyor.

Aşağıdaki kodu boş bir modüle yapıştırın. Sonra sayfanıza bir buton-düğme ekleyip makaro ata işlemini yapın. Sonra butona tıkladığınızda kod çalışacaktır.

Kod 1-99 arası isimleri olan sayfalarda arama işlemi yapar..

Arada olan ama isimleri farklı olan sayfalar var. Bunları dikkate almaz.

Option Explicit

Sub Benzersiz_Tank_Listesi()
    Dim WS As Worksheet
    Dim S1 As Worksheet
    Dim HeaderCell As Range
    Dim Last_Row As Long
    Dim X As Long
    Dim Tank_No As String
    Dim Firma As String
    Dim Key_List As Variant
   
    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
        .EnableEvents = False
    End With
   
    Set S1 = Worksheets("BENZERSİZ SAYDIRMA")
   
    S1.Range("A3:C" & S1.Rows.Count).ClearContents
   
    With CreateObject("Scripting.Dictionary")
        For Each WS In ThisWorkbook.Worksheets
            If IsNumeric(WS.Name) Then
                If CLng(WS.Name) >= 1 And CLng(WS.Name) <= 99 Then
                    Set HeaderCell = WS.Columns("C").Find( _
                                        What:="TANK Plaka No(Control no)", _
                                        LookAt:=xlWhole, _
                                        MatchCase:=False)
                   
                    If Not HeaderCell Is Nothing Then
                        Last_Row = WS.Cells(WS.Rows.Count, "C").End(xlUp).Row
                       
                        For X = HeaderCell.Row + 1 To Last_Row
                            Tank_No = Trim$(WS.Cells(X, "C").Value)
                           
                            If LenB(Tank_No) > 0 Then
                                Firma = Trim$(WS.Cells(X, "B").Value)
                               
                                If Not .Exists(Tank_No) Then
                                    .Add Tank_No, Firma
                                End If
                            End If
                        Next
                    End If
                End If
            End If
        Next
   
        Key_List = .Keys
   
        If .Count > 0 Then
            For X = 0 To .Count - 1
                S1.Cells(X + 3, "A").Value = X + 1
                S1.Cells(X + 3, "B").Value = Key_List(X)
                S1.Cells(X + 3, "C").Value = .Item(Key_List(X))
            Next
        End If

Safe_Exit:

        Set S1 = Nothing

        With Application
            .ScreenUpdating = True
            .Calculation = xlCalculationAutomatic
            .EnableEvents = True
        End With
   
        MsgBox .Count & " adet benzersiz tank numarası bulundu.", vbInformation
    End With
End Sub