• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Klasör içindeki dosya isimlerini tabloda yazılan isimlerle eşleştirmek

tam olarak ne yaptınız kodu eklermisiniz buraya

17 nolu mesajdaki kodunda söylediğim değişikliği yaptım.
 
Sn. @halit3 hocam 5 nolu örnek dosyayı indirip kendi orjinal datalarımı (tc kimlik numaralarını) D sutununa yazdım, Dosyayı Arama yapacağım klasör içine kaydettim. Arama yapacağım klasörde dosya isimlerim 60112378025 TAHSİN ANARAT 2323 (ögkk) şeklinde 5 bine yakıt data mevcut, örnek dosyamdaki D sutununda ise saadece 60112378025 TC kimlik numaram var. Bu numarayı içeren dosya ismi olduğu için ilgili sutuna VAR yok ise YOK diye yazacak. Eğer dosya isimleri saadece TC kimlik numarasından mevcut olsaydı kodda herhangi bir sıkıntı yaşamadım. 17 nolu mesajınızdaki kodu uyguladığımda uzun bir döngüye giriyor, herhangi bir sonuç eretmiyor.
 
kod dosya sayısına göre ve verilerdeki son dolu satıra göre içerisinde arayacağı için veriler ve dosya sayısına göre zaman alabilir
 
Sn. @halit3 hocam inatla sonucu bekledim, ancak 15 dk. oldu halen devam ediyor. Kesmek zorunda kaldım. Aynı adet veriyi saadece TC olan dosyamda (FOTO) klasörenden 4-5 sn. getiriyor.
 
Önceki mesajlarım da Klasör yolundaki dosya bire bir eşleştiğinde kod çok hızlı çalışır ancak siz içerisinde aramak istiyorsunuz bir örnek verelim
D5 hücresinde şu olsun
D5=123456789
veya
d5=deneme
klasördeki dosyaların birinde (veri123456789.xls") diğerinde "124deneme.xls" dosyalarda arama yapacağımdan bütün dosyalar taranacaktır ve içerisinde eşleşenleri arayacaktır.
Diğer taraftan önceki mesajlarımda direk dosya aranıyordu tarama yapılmıyordu ondan dolayı kod klasördeki dosya sayısına göre yavaş veya hızlı çalışacaktır
 
Bu yöntemle aramak çok uzun sürer şöyle bir şey olabilir
Klasördeki dosyaları sayfanın bir sutünuna almak lazım buradan da döngü ile bul sorgusu gibi yapmak daha hızlı olacaktır.
 
Bir çok yazı yazdım kod dosya isminin içerisinde arama yapınca örnek bin tane pdf dosya olsun bunların hepsinde arama yapacak bu yöntemle kod yavaş çalışır bire bir eşleşmede kod çok daha hızlı çalışacaktır.
 
Önceden yazdığım kod da bire bir eşleşme yapıyordu burada

For t = 5 To Cells(Rows.Count, "D").End(3).Row
aranan = Cells(t, "D").Value
If fs.FileExists(yol & "\" & aranan & "." & uzanti) = True Then
Cells(t, "P").Value = "VAR"
Else
Cells(t, "P").Value = "YOK"
End If
Next t

şimdi ise içerisinde arama yapması gerekiyor.

For t = 5 To Cells(Rows.Count, "D").End(3).Row
aranan = Cells(t, "D").Value
For Each Dosya In CreateObject("Scripting.FileSystemObject").GetFolder(yol).Files
bulunan = fs.GetBaseName(Dosya.Name)
If bulunan Like "*" & Trim(aranan) & "*" = True Then
Cells(t, "P").Value = "VAR"
GoTo atla
End If
Next
Cells(t, "P").Value = "YOK"
atla:
Next t

dolayısıyla bir döngü var bu döngü dosya sayısına ve hücredeki veri sayısına göre süre alacaktır.
 
Tc nin başta olduğunu düşünürsek, saadece ilk 11 karektere yani tc numarasına bakmiş olsa daha hızlı çalışırmı hocam.
 
yine dögü gerekiyor
siz dosyaların adını TC Kimlik olarak değiştirseniz olmuyormu.
 
Bu kod sanki birazcık daha hızlı

Kod: 
Sub Klasorden_dosyaları_bul()
'Application.ScreenUpdating = False
'Application.DisplayAlerts = False
yol = ThisWorkbook.Path

ReDim dosyalar(65000)

Dim fs As Object, t As Long
Set fs = CreateObject("Scripting.FileSystemObject")
say = 0
For Each Dosya In fs.GetFolder(yol).Files
bulunan = fs.GetBaseName(Dosya.Name)
say = say + 1
dosyalar(say) = bulunan
Next

For t = 5 To Cells(Rows.Count, "D").End(3).Row
aranan = Cells(t, "D").Value
For i = 1 To say
deg = dosyalar(i)
If deg Like "*" & Trim(aranan) & "*" = True Then
Cells(t, "P").Value = "VAR"
GoTo atla
End If
Next i
Cells(t, "P").Value = "YOK"
atla:
Next t

MsgBox "işlem tamam"

End Sub
 
Sizin dosyanızda formüller varmı onlarda kodu yavaşlatır.
 
Bu kodda formülleri iş bitene kadar durduruyor.
Rich (BB code): 
Sub Klasorden_dosyaları_bul()
With Application
.Calculation = xlManual
.ScreenUpdating = False
.EnableEvents = False
End With

yol = ThisWorkbook.Path
ReDim dosyalar(65000)

Dim fs As Object, t As Long
Set fs = CreateObject("Scripting.FileSystemObject")
say = 0

For Each dosya In fs.GetFolder(yol).Files
If LCase(fs.GetExtensionName(dosya)) = "pdf" Then
say = say + 1
dosyalar(say) = fs.GetBaseName(dosya.Name)
End If
Next

For t = 5 To Cells(Rows.Count, "D").End(3).Row
aranan = Cells(t, "D").Value
For i = 1 To say
deg = dosyalar(i)
If deg Like "*" & Trim(aranan) & "*" = True Then
Cells(t, "P").Value = "VAR"
GoTo atla
End If
Next i
Cells(t, "P").Value = "YOK"
atla:
Next t

With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlAutomatic
End With

MsgBox "işlem tamam"
End Sub
 
Son düzenleme:
Farklı bir kod sanki birazcık daha hızlı

Kod: 
Dim dosyalar(65000)
Dim say

Sub Klasorden_dosyaları_bul()

With Application
.Calculation = xlManual
.ScreenUpdating = False
.EnableEvents = False
End With
say = 0
Liste (ThisWorkbook.Path)

For t = 5 To Cells(Rows.Count, "D").End(3).Row
aranan = Cells(t, "D").Value
For i = 1 To say
deg = dosyalar(i)
If deg Like "*" & Trim(aranan) & "*" = True Then
Cells(t, "P").Value = "VAR"
GoTo atla
End If
Next i
Cells(t, "P").Value = "YOK"
atla:
Next t

With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlAutomatic
End With

MsgBox "işlem tamam"

End Sub
Private Sub Liste(yol As String)
Dim fs As Object, f As Object, t As Long
Set fs = CreateObject("Scripting.FileSystemObject")

For Each dosya In fs.GetFolder(yol).Files
If LCase(fs.GetExtensionName(dosya)) = "pdf" Then
say = say + 1
dosyalar(say) = fs.GetBaseName(dosya.Name)
End If
Next

On Error GoTo sonraki
For Each f In fs.GetFolder(yol).subfolders
Liste (f.Path)
sonraki:
Next
Set fs = Nothing
End Sub
 
Sn. @halit3 Hocam son iki kodu da denedim, ikisi de mükemmel çalışıyor 4 Bin satırda 8-11 saniyede sonuca gidiyor. Hakkınızı helal edin. Çok teşekkür ediyorum. Saygılar
 
34 nolu mesajdaki kod sadece tek klasördeki veriler ile işlim yapıyor 35 nolu mesajdaki kod alt klasörleride dahil ederek verilerde işlem yapıyor.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst