Farklı Dosyaları Karşılaştırma

oknakgl · 5 Mart 2018

Merhabalar,

Elimde 1000 adet farklı excel dosyası bulunmakta. Bu dosyalarda, başlangıç orta ve son olarak, 3 farklı başlık altında farklı maddeler sıralanıyor. Bu başlıkların her birini, altındaki maddelerle beraber blok olarak değerlendirmem gerekiyor. Bu blokları da 1000 tane farklı dosya içinde tarayıp, her bir başlığın hangi dosyalarda, maddeleriyle beraber (sıralaması da birebir aynı olacak şekilde) tekrarlandığını bulmalıyım. Linkte paylaştığım dosyaları incelersek, Örneğin A dosyasındaki başlangıç bölümü B dosyasında tekrarlanıyor. Aynı şekilde B dosyasındaki orta bölümü C ve D dosyalarında tekrarlanıyor. Az sayıdaki dosya arasında bu bölümlerin tespiti kolay oluyor. Fakat B C ve D'de aynı olan orta bölümünün, 1000 dosya içinde, başka hangi dosyalarda tekrarlandığını bulmaya çalıştığımda iş biraz zorlaşıyor. Bu sorunun yardımı için yardımcı olabilirseniz gerçekten çok memnun olacağım.

Şimdiden teşekkürler.

Dosyaları bu linkten indirebilirsiniz.

https://we.tl/nbUXlLyKUG

alicimri · 6 Mart 2018

1- Bütün dosyalarınızda madde sayıları aynımı. BAŞLANGIÇ için 6 madde gibi
2- İhtiyacınız olduğunda tek tek mi sorgulayacaksınız?.Yoksa bütün eşleşenleri liste halinde mi istiyorsunuz.

alicimri · 7 Mart 2018

1 Veri olan dosyalarınızın hepsi tek klasörde olduğunu varsaydım.
2 Ekteki a1.xls dosyasını dosyalarınızın olduğu klasörün dışında bir yere kopyalayın
3 Bu a1.xls dosyasının makronun olduğu modülü açın
a) Aşağıdaki satırı bulun ve kırmızı olan yere dosyalarınızın bulunduğu klasör yolunuzu yazın

Kod:

yol = "[COLOR="Red"]klasör yolu[/COLOR]"

örnek:
yol = "D:\dosya"
gibi
b) Tools/Refersences e tıklayın. açılan listede üst kısımlarda "Microsoft Scripting Runtime" nin yanında çek işareti yoksa, (Alfabetik sıralı listede) bulup, işaretleyin.
4 BAŞLANGIÇ sayfasındaki AKTAR düğmesine tıklayın
Sayfa adlarının bölüm adları olduğuna dikkat edin.
Makro çalışması bittiğinde A sütunu Dosya adları, B sütununda ise bu dosya adları ile eşleşen diğer dosya adları var.
Makro biraz uzun sürebilir daha hızlı bir yol bulamadım.
https://we.tl/Zhj98GhCKq

oknakgl · 7 Mart 2018

Çalışma için teşekkürler.

1.Bütün dosyalarda madde sayısı aynı değil malesef.

Makroda satır aralığı belirtildiğinden, madde sayısı farklı olan dosyalarda tam olarak doğru çalışmıyor.

Madde sayıları farklı olunca, makroyu buna uyarlamak zorlaşacak diye düşünüyorum. O yüzden başlıkları sütunlara dağıtabiliriz, basitleştirmek için.

2. Başlangıçta tüm eşleşenleri bulmalıyım. Ama ilerleyen süreçte, tek bir dosya için de sorgulama yapmam gerekecek. Onun için de, sorgulayacağım dosya ile karşılaştırma yapılacak diğer dosyaları farklı klasörlere koyup o şekilde tanımlama yapabilir miyiz ? İki klasöre de tüm dosyaları koyarsam, tamamının karşılaştırma sonucunu, kaynak klasörde tek bir dosya bırakırsam da sadece o dosyayı hedef klasördeki diğer tüm dosyalarla kıyaslama yapabilir miyim ?

Bir de dosyalara bazı eklemeler yapmam gerekiyor. Büyük ihtimal başlık sayısı artacak. Başlık sayısına ilave yapmamız mümkün müdür ?

Yardımınız için tekrardan teşekkürler.

alicimri · 7 Mart 2018

1 Madde sayısı değişken olursa sorun çıkmaz Find fonksiyonu ile halledebiliriz.
2 Eşleşenleri a1.xls dosyasında topladıktan sonra bu dosya içinde tek dosya bazında arama yaptırılabilir. Ayrı klasörler meselesini anlamadım.
3 Siz Başlıklar meselesini netleştirin ona göre kodları düzeltelim.

oknakgl · 8 Mart 2018

ALT ÜST YAN olarak 3 başlık daha eklememiz gerekiyor.
Madde sayılarının değişken olmasına göre kodları güncelleyip, belirttiğim 3başlık için de ilave yapabilirsek çok güzel olacak.

alicimri · 8 Mart 2018

1 a1.xls dosyasına 3 sayfa daha ekleyin. Sayfa sekme ad ve sırası aşağıdaki gibi olsun
BAŞLANGIÇ, ORTA, SON, ALT, ÜST, YAN
2. Yine veri dosyalarda başlıklar Alt alta aynı sırada olsun
3. Herhangi bir başlıkta maddeler olmayacak bir durum varsa aynı sırada maddeler için boşluk vermeden bu başlığı yine de yazın.
a1.xls dosyasındaki kodları, aşağıdaki kodlarla değiştirin.

Kod:

Sub ListeYap()
Application.ScreenUpdating = False
Dim Obj
Dim Klasor As Scripting.Folder, Dosya As Scripting.File
Set Obj = CreateObject("Scripting.FileSystemObject")
yol = "D:\dosya"
Set Kitap = ActiveWorkbook
For l = 1 To 6
Kitap.Sheets(l).Columns("A:B").Delete
Next
Set Klasor = Obj.GetFolder(yol)
DSay = Klasor.Files.Count + 1
For Each Dosya In Klasor.Files
Workbooks.Open (Dosya.Path)
say = Kitap.Sheets(1).Range("A65536").End(3).Row + 1

Zx = Workbooks(Dosya.Name).Sheets(1).Range("A65536").End(3).Row


For i = 2 To Zx
If Range("A" & i) = "ORTA" Or Range("A" & i) = "SON" Or Range("A" & i) = "ALT" Or Range("A" & i) = "ÜST" Or Range("A" & i) = "YAN" Then
yazi = yazi & Chr(10)
Else
yazi = yazi & Workbooks(Dosya.Name).Sheets(1).Cells(i, 1)
End If
Next
yaz = Split(yazi, Chr(10))

For v = 1 To 6
Kitap.Sheets(v).Range("a" & say).Value = Dosya.Name
Kitap.Sheets(v).Range("b" & say).Value = yaz(v - 1)
Kitap.Sheets(v).Range("c" & say).Formula = "=COUNTIF($B$2:$B$" & DSay & ", B" & say & ")"
Next
Workbooks(Dosya.Name).Close
yazi = ""
Next
    For i = 1 To 6
    ActiveWorkbook.Worksheets(i).Sort.SortFields.Clear
    ActiveWorkbook.Worksheets(i).Sort.SortFields.Add Key:=Range("B1"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets(i).Sort
        .SetRange Range("A2:C5")
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Next
     For i = 1 To 6
    For e = 2 To DSay
    If Sheets(i).Cells(e - 1, 2) <> Sheets(i).Cells(e, 2) And Sheets(i).Cells(e + 1, 2) = Sheets(i).Cells(e, 2) Then
    sayi = 1
    For w = Sheets(i).Range("B" & e).Row To (Sheets(i).Range("c" & e) - 1) + Sheets(i).Range("C" & e).Row
  adi = adi & Sheets(i).Range("A" & w) & " "
  Sheets(i).Range("D" & e & ":D" & (Sheets(i).Range("c" & e) - 1) + Sheets(i).Range("C" & e).Row) = adi
    Next
       adi = ""
    End If
     Sheets(i).Range("D" & e) = Trim(Replace(Sheets(i).Range("D" & e), Sheets(i).Range("A" & e), ""))
         Sheets(i).Range("D" & e) = Trim(Replace(Sheets(i).Range("D" & e), "  ", " "))

    Next
     Sheets(i).Columns(3).Delete
    Sheets(i).Columns(2).Delete
  
    Next
Application.ScreenUpdating = True
End Sub

Bu kodları deneyin, işlemi istediğiniz gibi yapıyorsa, tek dosya bazında arama işine geçelim.

oknakgl · 8 Mart 2018

Madde sayılarının farklı olması durumu için çalışıyor fakat karşılaştırma sonucunu sadece adet olarak veriyor. İlk çalışmadaki gibi dosya ismini göremez miyiz ?

alicimri · 8 Mart 2018

Size cevabı başka bir yerden yazmıştım
Evde kodları denedim normal çalışıyor. Dosyanın yeni hali ekte dosya klasörünün yolunu kendinize uyarlayın
https://we.tl/JS2GQ8o0Tx
Tek tek aramayı veri dosyaları içinden mi yoksa a1.xls dosyası içinden mi yapmak istiyorsunuz.
Yada a.xls alma işlemi bittikten sonra ikinci bir makro ile kodlar aşağıda veri dosyalarında başlıkların yanındaki B sütunundaki hücreye eşleştiği dosya adlarını yazdırıp işi toptan halletsek, olur mu

Kod:

Sub Makro1()
ad = ActiveWorkbook.Name
Yol = "D:\dosya"
For i = 2 To Sheets(1).Range("A65536").End(3).Row
Workbooks.Open (Yol & "/" & Range("A" & i))
say = 1
For e = 1 To ActiveSheet.Range("A65536").End(3).Row
If Range("A" & e) = "BAŞLANGIÇ" Or Range("A" & e) = "ORTA" Or Range("A" & e) = "SON" Or Range("A" & e) = "ALT" Or Range("A" & e) = "ÜST" Or Range("A" & e) = "YAN" Then
Range("B" & e).Value = Workbooks(ad).Sheets(say).Range("B" & i).Value
say = say + 1
End If
Next
ActiveWorkbook.Save
ActiveWorkbook.Close
Next
End Sub

Bu kodları a1.xls yapıştırıp yine Klasör yolunu değiştirin.

oknakgl · 10 Mart 2018

evet toptan halletsek olur.
İkinci makroyu ekledim ama B sütununa eşleştiği dosya adlarını yazmadı.

alicimri · 11 Mart 2018

Aktar tuşuna basınca iki makroyu birden çalıştırıyor. Daha sonra dosya yolunu kendinize göre değiştirin.
https://we.tl/3ucEeElzSJ

oknakgl · 12 Mart 2018

Tamamdır hallettim. Çok sağol, çok işimi görecek bir çalışma oldu.