Başka Çalışma kitabında aynı değer varsa

[Ahmet Sami]

İyi günler arkadaşlar, bir klasör içinde iki tane excel dosyam var. Yolluk isimli çalışma kitabına devamlı tarihsel veri giriyorum GENEL YOLLUK isimli çalışma kitabımda ise 3 yıldır girdiğim veriler var. Örnek olarak
B11 sütununa TC kimlik no
C11 sütununa adı soyadı
D11 sütununa gidiş tarihi
E11 sütununa geliş tarihini yazıyorum.
F11 sütununa da gittiği illeri yazıyorum.
Veri girişi B11:E300 ‘e kadar olabiliyor.
Sizden istediğim yardım. Şayet B11 ile E300 arasına veri girişi yaptığımda GENEL YOLLUK çalışma kitabında aynı TC kimlik numaralı personelin aynı tarihleri içeren bilgi varsa o tarihleri Yolluk isimli çalışma kitabında yani D11300 gidiş tarihi bölümü E11:E300 geliş tarih bölümünü kırmızı renk yapması. İlginizden dolayı şimdiden teşekkür ederim.

 

[askm]

Örnek dosyalarınızı ekleyebilir misiniz.

 

[Ahmet Sami]

iyi günler dosya gönderiyorum teşekkür ederim
http://s5.dosya.tc/server5/meiiu5/YOLLUK.rar.html

 

[çıtır]

Sayın Ahmet Sami ;Silme link'ini paylaşmışsınız.Dosyanız silinmiş durumda.
Tc dosya yükleme sitesine dosyayı yükledikten sonra üstteki link paylaşın.
Alttaki link dosyayı silme işlemi görür.

 

[Ahmet Sami]

Doğrudur efendim linki değiştirdim ilginizden dolayı teşekkür ederim.
Şuan indirme olarak çalışıyor
http://www.dosya.tc/server10/jbb34z/YOLLUK.rar.html

 

[askm]

Aşağıdaki kodları bir butona ekleyip kullanabilirsiniz.

Sub ASKM_KAYIT_ARA()
Dim aktif_Ktp, SayfaAdi, Aktif_syf, Sayfa
Dim Aranan1, Aranan2, Aranan3 As String
Dim SonSat1, SonSat2
Dim dosya_yeri, dosya
aktif_Ktp = ThisWorkbook.Name
Aktif_syf = "YOLLUK"
dosya_yeri = ThisWorkbook.Path & "\"
dosya = "GENEL YOLLUK.xls"
SayfaAdi = "VERİ"

Application.DisplayAlerts = False

Workbooks.Open (dosya_yeri & dosya)
SonSat1 = Range("B" & Rows.Count).End(xlUp).Row
SonSat2 = Workbooks(dosya).Sheets(SayfaAdi).Range("B" & Rows.Count).End(xlUp).Row

For x = 11 To SonSat1
    Aranan1 = Workbooks(aktif_Ktp).Sheets(Aktif_syf).Cells(x, 2).Value
    Aranan2 = CDate(Workbooks(aktif_Ktp).Sheets(Aktif_syf).Cells(x, 4).Value)
    Aranan3 = CDate(Workbooks(aktif_Ktp).Sheets(Aktif_syf).Cells(x, 5).Value)
    Set Bul = Workbooks(dosya).Sheets(SayfaAdi).Range("B2:B" & SonSat2).Find(Aranan1)
            If Bul Is Nothing Then
            Else
                Satir = Bul.Row
                If Aranan2 = Workbooks(dosya).Sheets(SayfaAdi).Range("D" & Satir) And Aranan3 = Workbooks(dosya).Sheets(SayfaAdi).Range("E" & Satir) Then
                    Range("B" & x & ":H" & x).Interior.Color = vbRed
                End If
            End If
Next
Workbooks(dosya).Close
MsgBox "Kayıtlar incelendi...", vbInformation, "A S K M"
End Sub

 

[Ahmet Sami]

Sayın Askm çok teşekkür ederim. İşime yaradı ancak renkler bulduktan sonra sabit kalıyor. Veriler değiştirip yeni veri girdiğim zaman ve yeni arama kıyası yaptırdığım zaman eski renkler gitmiyor aynı kalıyor silinmiyor

 

[askm]

Application.DisplayAlerts = False den önce veya sonra Cells.Interior.Color = xlNone eklerseniz sorun çözülür.

 

[Ahmet Sami]

Çok teşekkür ederim emeğinize elinize sağlık

 

[askm]

Rica ederim. Kolay gelsin.