Excel Forum

Excel Forum (http://www.excel.web.tr/index.php)
-   Windows-Word-PowerPoint.... (http://www.excel.web.tr/forumdisplay.php?f=51)
-   -   Bir klasör içerisin de çoklu arama yapmak (http://www.excel.web.tr/showthread.php?t=131612)

mustilem23 24-07-2013 13:34

Bir klasör içerisin de çoklu arama yapmak
 
merhabalar ,

bir klasörüm içerin de 100 lerce excel dosyam var ve bu dosyaların içerin de malzeme nosu diye bir kavram var ben bazen 10 adet malzeme kodu aramam gerekiyor mecburen tek tek arayıp buluyorum .çoklu arama nasıl yapabilirim yardımcı olabilir misiniz.

mustilem23 24-07-2013 16:13

ilgilenebilir iseniz çok makbule geçecek benim için.

mustilem23 02-08-2013 16:39

üstadlar bu konuda yardımcı olabilir iseniz çok makbule geçecek.

omerceri 03-08-2013 16:41

Arama yapılacak dosya yapısını görmek için örnek dosya eklerseniz, daha kolay yardım alırsınız.

nikferli 03-08-2013 18:21

windows aramayı kullan
 
windows arama programı kullan.
indeks oluştursun. sonra aradığın ismi bütün dosyalarda bulur.

Korhan Ayhan 04-08-2013 02:52

2 Eklenti(ler)
Merhaba,

Ekteki örnek dosyayı inceleyiniz.

Dosyayı masaüstüne indirin.
Dosyayı açın butona tıklayın.
İlgili klasörü seçin.
Aramak istediğiniz kodu yazın.
Arkanıza yaslanıp işlemin bitmesini bekleyin.

Kullanılan kod;

Kod:

Option Explicit

Sub KLASORDE_COKLU_KOD_ARAMA()
    Dim Klasor As Object, Dosya As String, Aranan  As Variant
    Dim Hedef_Kitap As Workbook, Sayfa As Worksheet, Satir As Long
    Dim K1 As Workbook, S1 As Worksheet, Bul As Range, Adres As String
   
    Set K1 = ThisWorkbook
    Set S1 = K1.Sheets("Sayfa1")
   
    Set Klasor = CreateObject("Shell.Application").BrowseForFolder(0, "Klasör seçiniz !", 1)
    If Klasor Is Nothing Then Exit Sub
   
    Aranan = InputBox("Lütfen aradığınız kodu giriniz...", "Kod arama işlemi...")
    If Aranan = False Or Aranan = "" Then Exit Sub
   
    Application.ScreenUpdating = False
   
    S1.Range("A2:D" & Rows.Count).Clear
    Dosya = Dir(Klasor.Self.Path & "\*.*")
   
    While Dosya <> ""
        Set Hedef_Kitap = Workbooks.Open(Klasor.Self.Path & "\" & Dosya, False, False)
        DoEvents
        For Each Sayfa In Hedef_Kitap.Worksheets
            Set Bul = Sayfa.Cells.Find(Aranan, , , xlWhole)
            If Not Bul Is Nothing Then
            Adres = Bul.Address
                Do
                    Satir = S1.Cells(Rows.Count, 1).End(3).Row + 1
                    S1.Cells(Satir, 1) = Dosya
                    S1.Cells(Satir, 2) = Sayfa.Name
                    S1.Cells(Satir, 3) = Bul.Address(False, False)
                    S1.Hyperlinks.Add Anchor:=S1.Cells(Satir, 4), _
                    Address:=Klasor.Self.Path & "\" & Dosya, SubAddress:=Sayfa.Name & "!" & S1.Cells(Satir, 3), _
                    TextToDisplay:="Ulaşmak için tıklayınız..."
                    Set Bul = Sayfa.Cells.FindNext(Bul)
                Loop While Not Bul Is Nothing And Bul.Address <> Adres
            End If
        Next
        Hedef_Kitap.Close 0
        Dosya = Dir
    Wend
   
    S1.Range("A:D").EntireColumn.AutoFit
   
    Set Bul = Nothing
    Set K1 = Nothing
    Set S1 = Nothing
    Set Klasor = Nothing

    Application.ScreenUpdating = True

    If Satir > 1 Then
        MsgBox "İşleminiz tamamlanmıştır.", vbInformation
    Else
        MsgBox Aranan & " numaralı kod bulunamamıştır!", vbCritical
    End If
End Sub


mustilem23 19-01-2015 09:57

Sayın Korhan Bey ,

biliyorum konu hakkında dönüşüm çok geç oldu fakat sanırım email hatıraltıcısı bilgi iletmemiş eski konularımı ararken rastladım ,öncelikle ilginiz için çok tesşekkür ederim ,

rica etsem örnek dosyayı başka bir paylaşım serverine ekleyebilir misiniz.

feridici_genc 19-01-2015 10:19

buyrun,
http://s3.dosya.tc/server30/CHCcMT/_RNEK.rar.html

mustilem23 19-01-2015 17:08

sayın feridici_genc ilginiz için teşekkürler.

Sayın korhan Bey
makro çok güzel çalışıyor fakat sadece gösterilen klasörde arama yapıyor ,o klasöre ait bir alt klasör var ise hata veriyor birde aşağıda resimde bahsetmek istediğim gibi klasör içerisinde excelden farklı bir dosya türü olursa aşağıdaki debug hatasını veriyor.

http://www.resimupload.net.tr/image.php?di=TQ6T

rica etsem butona tıkladığımız da klasöre göz at dediğimiz de bilgisayarımı komple gösterdiğim de referans nosunu yazdığımızda excelleri bulacak şekilde düzenleyeilmeniz mümkün müdür.

amacım ,örneğin bir refarans nosunun kodu değiştiğinde sistemde bu bana bilgi olarak geliyor fakat bilgisayarımda bulunan excellerin içindeki refaransların da değiştirmem gerekiyoryardımcı olabilirseniz çok mkbule geçecek iyi günler.

mustilem23 20-01-2015 14:25

Korhan Bey rica etsem inceleyebilme imkanınız var mıdır


Saat 10:51

Powered by vBulletin Version 3.7.2
Copyright ©2000 - 2017, Jelsoft Enterprises Ltd.