30 excel dosyası içinde bir kelime aratma

[ayantas]

Farklı farklı 30 a yakın excel dosyam var. bir exe içerisinden 30 excel dosyası içerisinde kalem kelimesi geçen excel dosyalarını nasıl bulabilirim.

 

[yakup7904]

30 dosyanın kayıtlı olduğu klasör üzerine sağ tıkla - Ara - Dosya Adı kısmına *.xls

Dosyadaki metin ve Deyim Kısmına kalem kelimesini girip arayabilirsiniz..

 

[ALPEN]

File-> Open

 

[xxrt]

Alpenin çözümüde olur ama kod olarak da;Dosyaları Sayfanıza ekliyerek,Görerek Bulabilirsiniz.Burada excellerin yolu olarak
D:\Belgelerim aldım.Siz yolu değiştirebilrsiniz.Kodları modüle yapıştırın.Daha sonra Butona FileList makrosunu atayın.

Sub FileList()
Dim FileNamesList As Variant, i As Integer
FileNamesList = CreateFileList("*.xls", True)
Range("A:B").ClearContents
For i = 1 To UBound(FileNamesList)
Cells(i + 1, 1) = FileNamesList(i)
Cells(i + 1, 2) = FileSize(Dir(FileNamesList(i)))
Next
Columns("A:B").AutoFit
End Sub
Function CreateFileList(FileFilter As String, IncludeSubFolder As Boolean) As Variant
Dim FileList() As String, FileCount As Long
CreateFileList = ""
Erase FileList
With Application.FileSearch
.NewSearch
.LookIn = "D:\Belgelerim\"
.Filename = FileFilter
.SearchSubFolders = IncludeSubFolder
If .Execute(SortBy:=msoSortByFileName, SortOrder:=msoSortOrderAscending) = 0 Then Exit Function
ReDim FileList(.FoundFiles.Count)
For FileCount = 1 To .FoundFiles.Count
FileList(FileCount) = .FoundFiles(FileCount)
Next
End With
CreateFileList = FileList
Erase FileList
End Function

Function FileSize(filespec)
Dim fs, f, f1, fc
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder("D:\Belgelerim\")
Set fc = f.Files
For Each f1 In fc
If f1.Name = filespec Then FileSize = f1.Size / 1024 & " Kb"
Next
End Function

Dosyalar Geldikten Sonra şu makro ile Dosyaların adlarını ayırarak İstediğin dosyayı fonksiyonlarla Bulabilirsin..Tabi bu yöntem tam istediğiniz değil ama yinede örnek olarak bulunsun.

Sub ayır()
    Columns("A:A").Select
    Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
        :="\", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1))
    ActiveWindow.ScrollColumn = 2
End Sub