30 excel dosyası içinde bir kelime aratma

Katılım
15 Eylül 2004
Mesajlar
1
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.
 
Katılım
31 Ağustos 2004
Mesajlar
22
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..
 
X

xxrt

Misafir
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.
Kod:
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.
Kod:
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
 
Üst