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

halit3

Uzman
Uzman
Katılım
18 Ocak 2008
Mesajlar
12,760
Excel Vers. ve Dili
2003 excell türkçe
ve
2007 excell türkçe
tam olarak ne yaptınız kodu eklermisiniz buraya

17 nolu mesajdaki kodunda söylediğim değişikliği yaptım.
 

tahsinanarat

Altın Üye
Katılım
14 Mart 2005
Mesajlar
2,158
Excel Vers. ve Dili
Ofis 2019 Türkçe
Altın Üyelik Bitiş Tarihi
27-05-2028
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.
 

halit3

Uzman
Uzman
Katılım
18 Ocak 2008
Mesajlar
12,760
Excel Vers. ve Dili
2003 excell türkçe
ve
2007 excell türkçe
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
 

tahsinanarat

Altın Üye
Katılım
14 Mart 2005
Mesajlar
2,158
Excel Vers. ve Dili
Ofis 2019 Türkçe
Altın Üyelik Bitiş Tarihi
27-05-2028
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.
 

halit3

Uzman
Uzman
Katılım
18 Ocak 2008
Mesajlar
12,760
Excel Vers. ve Dili
2003 excell türkçe
ve
2007 excell türkçe
Ö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
 

halit3

Uzman
Uzman
Katılım
18 Ocak 2008
Mesajlar
12,760
Excel Vers. ve Dili
2003 excell türkçe
ve
2007 excell türkçe
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.
 

tahsinanarat

Altın Üye
Katılım
14 Mart 2005
Mesajlar
2,158
Excel Vers. ve Dili
Ofis 2019 Türkçe
Altın Üyelik Bitiş Tarihi
27-05-2028
Sn. @halit3 hocam dosyalarımın hepsi pdf dir. Pdf dosyadının adında arama yapılacak tır.
 

halit3

Uzman
Uzman
Katılım
18 Ocak 2008
Mesajlar
12,760
Excel Vers. ve Dili
2003 excell türkçe
ve
2007 excell türkçe
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.
 

halit3

Uzman
Uzman
Katılım
18 Ocak 2008
Mesajlar
12,760
Excel Vers. ve Dili
2003 excell türkçe
ve
2007 excell türkçe
Ö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.
 

tahsinanarat

Altın Üye
Katılım
14 Mart 2005
Mesajlar
2,158
Excel Vers. ve Dili
Ofis 2019 Türkçe
Altın Üyelik Bitiş Tarihi
27-05-2028
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.
 

halit3

Uzman
Uzman
Katılım
18 Ocak 2008
Mesajlar
12,760
Excel Vers. ve Dili
2003 excell türkçe
ve
2007 excell türkçe
yine dögü gerekiyor
siz dosyaların adını TC Kimlik olarak değiştirseniz olmuyormu.
 

halit3

Uzman
Uzman
Katılım
18 Ocak 2008
Mesajlar
12,760
Excel Vers. ve Dili
2003 excell türkçe
ve
2007 excell türkçe
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
 

halit3

Uzman
Uzman
Katılım
18 Ocak 2008
Mesajlar
12,760
Excel Vers. ve Dili
2003 excell türkçe
ve
2007 excell türkçe
Sizin dosyanızda formüller varmı onlarda kodu yavaşlatır.
 

halit3

Uzman
Uzman
Katılım
18 Ocak 2008
Mesajlar
12,760
Excel Vers. ve Dili
2003 excell türkçe
ve
2007 excell türkçe
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:

halit3

Uzman
Uzman
Katılım
18 Ocak 2008
Mesajlar
12,760
Excel Vers. ve Dili
2003 excell türkçe
ve
2007 excell türkçe
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
 

tahsinanarat

Altın Üye
Katılım
14 Mart 2005
Mesajlar
2,158
Excel Vers. ve Dili
Ofis 2019 Türkçe
Altın Üyelik Bitiş Tarihi
27-05-2028
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
 

halit3

Uzman
Uzman
Katılım
18 Ocak 2008
Mesajlar
12,760
Excel Vers. ve Dili
2003 excell türkçe
ve
2007 excell türkçe
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.
 
Üst