Bir çok Excel Kitabında mükerrer kayıt bulma..

[DidO Didem]

Merhaba,
Formunuza yeni üye oldum.
İşyerinden bir arkadaşım tavsiye etti . Yardımcı olabileceklere şimdiden teşekkür ederim.

Bir klasorun altında bir cok excel dosyası var. içerisinde mukerer kayıt olan sutunlardaki kayıtların işaretlenmesini ya da kayıtların hangi adreslerde oldugunu listelemesine ihtiyacım var.

şöyleki .

A.xls de A sutununda tekarar eden kayıt varsa renklensin.. B stunundaki lerde.
B.xls de de aynı şekilde
ve bunu klasorun altındaki onlarca dosyaya yapması mümkün mü acaba...

 

[cemshan]

Koşullubiçimlendirme ile çok rahat çözebilirsiniz.

Örnek dosyanızı paylaşırsanız hızlı çözüm bulursunuz

 

[DidO Didem]

merhaba ,
ben bir excel dosyasindan ayni klasorun altindaki bir cok excel dosyasindaki mukerrer kayitlari isaretlemeyi sormustum. 300 sayfa var hepsine tektek girip kosullu bicimlendirme yapmak cok zaman alir o yuzden makro ile cozum ariyorum tek dosyadan hepsine uygulanacak. tesekkurler

 

[Ömer]

Merhaba,

Bu şekilde deneyin.

Sub Mukerrer_Renklendir()

    Dim klasor As String, dosya

    klasor = "C:\Deneme" [COLOR="DarkGreen"]'dosya yolu ve adını buraya yazın.
[/COLOR]
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    For Each dosya In CreateObject("Scripting.FileSystemObject").GetFolder(klasor).Files
        If ThisWorkbook.Name <> dosya.Name Then
            Workbooks.Open Filename:=dosya
            With Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row)
                .FormatConditions.Delete
                .FormatConditions.AddUniqueValues
                .FormatConditions(1).DupeUnique = xlDuplicate
                .FormatConditions(1).Interior.ColorIndex = 3
            End With
            With Range("B1:B" & Cells(Rows.Count, "B").End(xlUp).Row)
                .FormatConditions.Delete
                .FormatConditions.AddUniqueValues
                .FormatConditions(1).DupeUnique = xlDuplicate
                .FormatConditions(1).Interior.ColorIndex = 4
            End With
            ActiveWorkbook.Close True
        End If
    Next
    
    MsgBox "İşleminiz Bitti..."
    Application.ScreenUpdating = True

End Sub

.

 

[DidO Didem]

Ömer Bey Çok teşekkür ederim.

Çalıştı sadece .xlsm uzantılı dosyalar vardı onlarda sorun cıktı onları yapmamış. Fakat onlar zaten çok değildi. Bu şekilde işimi bitirebildim. Tekrar teşekkür ederim elinize sağlık..

 

[Ömer]

İşinize yaradığına sevindim.
Tekrar denedim, .xlsm dosyalarında da çalıştı.

Bazı dosya türlerinde ekran sorgularını önlemek için aşağıdaki kodu ilave ettim.

Application.DisplayAlerts = False

.