Excel Hücredeki değeri Dosya içinde aynı isim olarak arama

[ozgurpeh]

Arkadaşlar MErhaba,

Oldukça fazla bir data için desteğinize ihtiyacım var. PC içinde bir klasör içinde yaklaşık 20000 adet pdf var bu pdflerin isimleri excelde A hücresinde yazıyor. A hücresinde yazan isimler gerçekten pc içindeki klasörde varmı bunun doğruluğunu kontrol etmemiz lazım örenek dosya içinde açıklama ekledim.
şimdiden desteğiniz için teşkkür ederim

 

[ÖmerBey]

Merhaba,
Aşağıdaki kodu deneyiniz.

Sub Kod()
yol = "C:\Desktop\Dosya1\"
Range("A:A").Interior.Color = xlNone
For a = 1 To Cells(Rows.Count, 1).End(3).Row
    dsy = Cells(a, 1)
    kntrl = Dir(yol & dsy & ".pdf")
    If kntrl = "" Then
        Cells(a, 1).Interior.Color = vbRed
    Else
        Cells(a, 1).Interior.Color = vbGreen
    End If
Next
End Sub

 

[ozgurpeh]

Merhaba,
Aşağıdaki kodu deneyiniz.

Sub Kod()
yol = "C:\Desktop\Dosya1\"
Range("A:A").Interior.Color = xlNone
For a = 1 To Cells(Rows.Count, 1).End(3).Row
    dsy = Cells(a, 1)
    kntrl = Dir(yol & dsy & ".pdf")
    If kntrl = "" Then
        Cells(a, 1).Interior.Color = vbRed
    Else
        Cells(a, 1).Interior.Color = vbGreen
    End If
Next
End Sub

Desteğiniz için teşkkür ederim, fakat hepsi kızardı ? Var olanları malesef yeşertmedi

 

[ÖmerBey]

Örnek dosyanızda olduğu halde yeşil olmayan Pdf dosyanızın bir tanesinin dosya yolunu da içeren tam adını paylaşır mısınız.

 

[ozgurpeh]

Örnek dosyanızda olduğu halde yeşil olmayan Pdf dosyanızın bir tanesinin dosya yolunu da içeren tam adını paylaşır mısınız.

Evet güzel bir noktaya değindiniz çözdüm sorunu, kesinlikle dosya yolu ile alakalı. Bir detay daha sormak istiyorum bazı isimlerin sonuna -1 - 2 - 3 gibi sayılarda gelmiş biz bu hücredeki değeri aratabilirmiyiz. ÖZetle hücrede ahmet yazıyor ama PDF dosyasının adı Ahmet - 123 bu direk kızarıyor. Bunuda ahmet oalrak algılayacak şekilde kodu düzenleyebilir miyiz ?

 

[ÖmerBey]

İlgili kısmı aşağıdaki şekilde değiştirip deneyiniz.

kntrl = Dir(yol & dsy & "*.pdf")

 

[ozgurpeh]

İlgili kısmı aşağıdaki şekilde değiştirip deneyiniz.

Vakit ayırıp destek olduğunuz için teşekkürler,

 

[ÖmerBey]

Rica ederim, yardımcı olabildiysem ne mutlu.
İyi çalışmalar...

 

[ozgurpeh]

Bu konu ile ilgili olarak; klasör içinde excel sütunundaki ismi taşımayan dosyaları komple silebilir miyiz toplu olarak. Misal Hücrede Ahmet yazıyor Klasçr içinde Ahmet adında bir dosya varsa dursun ama mehmet yazan dosya silinsin

 

[ÖmerBey]

Merhaba,
Aşağıdaki kodu kullanabilirsiniz, ancak unutmayınız ki bu işlem risklidir ve dosyalarınızı kaybedebilirsiniz. Yedek almayı unutmayınız.
İlk satırdaki mavi kısmı kendi klasör yolunuzla değiştiriniz.
İkinci satırdaki kırmızı kısım kontrol için kullanılan yardımcı sütun adı olup dosyanızdaki boş bir sütun ile değiştirebilirsiniz.

Sub Kod()
yol = "C:\Desktop\Dosya1\"
stn = "Z" 'kontrol sütunu
Range("A:A").Interior.Color = xlNone
For a = 1 To Cells(Rows.Count, 1).End(3).Row
    dsy = Cells(a, 1)
    kntrl = Dir(yol & dsy & "*.pdf")
    If kntrl = "" Then
        Cells(a, 1).Interior.Color = vbRed
    Else
        Cells(a, 1).Interior.Color = vbGreen
        Cells(a, stn) = kntrl
    End If
Next
sil yol, stn & ":" & stn
End Sub

Private Sub sil(klsr, sutun)
dosya = Dir(klsr & "*.pdf")
Do While dosya <> ""
    If WorksheetFunction.CountIf(Range(sutun), dosya) = 0 Then Kill klsr & dosya
    dosya = Dir
Loop
Range(sutun).ClearContents
End Sub

 

[ozgurpeh]

Merhaba,
Aşağıdaki kodu kullanabilirsiniz, ancak unutmayınız ki bu işlem risklidir ve dosyalarınızı kaybedebilirsiniz. Yedek almayı unutmayınız.
İlk satırdaki mavi kısmı kendi klasör yolunuzla değiştiriniz.
İkinci satırdaki kırmızı kısım kontrol için kullanılan yardımcı sütun adı olup dosyanızdaki boş bir sütun ile değiştirebilirsiniz.

Sub Kod()
yol = "C:\Desktop\Dosya1\"
stn = "Z" 'kontrol sütunu
Range("A:A").Interior.Color = xlNone
For a = 1 To Cells(Rows.Count, 1).End(3).Row
    dsy = Cells(a, 1)
    kntrl = Dir(yol & dsy & "*.pdf")
    If kntrl = "" Then
        Cells(a, 1).Interior.Color = vbRed
    Else
        Cells(a, 1).Interior.Color = vbGreen
        Cells(a, stn) = kntrl
    End If
Next
sil yol, stn & ":" & stn
End Sub

Private Sub sil(klsr, sutun)
dosya = Dir(klsr & "*.pdf")
Do While dosya <> ""
    If WorksheetFunction.CountIf(Range(sutun), dosya) = 0 Then Kill klsr & dosya
    dosya = Dir
Loop
Range(sutun).ClearContents
End Sub

Bu süpermiş denedim valla gayet güzel temizledi. Elinize sağlık

Ozaman ben sizden son bir şey daha rica edeyim final olsun. Bir denetmene verilecek bu dosya, içinde bir liste (bu excel) ve ek klasör excelde A sütununda yaklaşık 20000 satır var her satırın karşılığı Dosya1 klasöründe bir PDF dosyayı temsil ediyor. Ben exceldeki A sütunundaki hücrelere tıkladığımda tıklanan hücredeki ismi yukarıdaki mantığa göre Dosya1 klasöründe bulup açabilir mi ?

 

[ÖmerBey]

İlgili sayfanın kod bölümüne aşağıdaki kodu kopyaladıktan sonra A sütununa çift tıklayıp deneyiniz.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Column = 1 Then
    Cancel = True
    yol = "C:\Desktop\Dosya1\"
    dosya = Dir(yol & Target.Text & "*.pdf")
    If dosya = "" Then
        MsgBox Target.Text & " dosyası " & yol & " klasöründe bulunamadı.", vbCritical
    Else
        CreateObject("Shell.Application").Open (yol & dosya)
    End If
End If
End Sub

 

[ozgurpeh]

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) If Target.Column = 1 Then Cancel = True yol = "C:\Desktop\Dosya1\" dosya = Dir(yol & Target.Text & "*.pdf") If dosya = "" Then MsgBox Target.Text & " dosyası " & yol & " klasöründe bulunamadı.", vbCritical Else CreateObject("Shell.Application").Open (yol & dosya) End If End If End Sub

Dosya yoksa eğer bulunamadı diyor ama var olan dosya için bir tepki yok, ne açıyor nede uyarı veriyor

 

[ozgurpeh]

Tamam açılıyor sıkıntı yok Çok teşekkürler