• DİKKAT

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

Makro ile arama yapmak

Y

yesimgurol

Katılım
8 Aralık 2011
Mesajlar
964
Excel Vers. ve Dili
Excel 2016,32bit
Merhabalar;

Ekteki dosyada "LİSTE" isimli çalışma sayfasında açıklama yapmaya çalıştım.Umarım istediğim olayı anlatabilmişimdir.

Klasör içindeki excel de hazırlanmış raporlar içinde belirlemiş olduğum değerleri arayıp excel de hazırladığım listeye buldukları değerleri yazsın istiyorum.

Bu konuda yardımcı olursanız çook mutlu olurum.Şimdiden ilginize teşekkür ederim.
 

Ekli dosyalar

sayfaları birleştirip rapor özet satırınızla rapor sayfa sonuçlarınız arasında köprü kurunca otomatik olarak alıyor.
 

Ekli dosyalar

Dosyanız ektedir.:cool:
Kod: 
Sub kapaliexcel_59()
Dim dosya As String, dsy As String, i As Long, sat As Long
Dim myrng, deg, deg2
Range("B3:C" & Rows.Count).ClearContents
sat = 3
dosya = Dir(ThisWorkbook.Path & "\*.xls")
Do While dosya <> ""
    If dosya <> ThisWorkbook.Name Then
        dsy = dosya
        deg = Application.ExecuteExcel4Macro("'" & ThisWorkbook.Path & _
        "\[" & dsy & "]RAPOR'!r86c3")
        If deg > 5 Then
            deg2 = Application.ExecuteExcel4Macro("'" & ThisWorkbook.Path & _
            "\[" & dsy & "]RAPOR'!r44c6")
            Cells(sat, "B").Value = deg
            Cells(sat, "C").Value = deg2
            sat = sat + 1
        End If
    End If
    dosya = Dir
Loop
MsgBox "İşlem Tamamlandı." & vbLf & "evrengizlen@hotmail.com", vbOKOnly + vbInformation
End Sub
 

Ekli dosyalar

Sayın Cems;
İlginiz için teşekkür ederim.Fakat bu raporlardan yaklaşık 300 adet var klasör içinde...O yüzden imkan varsa makro olsa daha kullanışlı olacağını düşünmüştüm.
 
3ncü mesaja bakınız.:cool:
 
Sayın Orion1;
Çok teşekkür ederim.Evet istediğim gibi olmuş.Liste kısmına buton ekledim denedim.Çok güzel gerçekten,ben bu işlemi tek tek bakıp yapıyordum o açıdan çok kullanışlı oldu benim için..yalnız "C2" hücresine değer yazmıyor.Yoksa ben mi yanlış birşeyler yapıyorum?
 
yesimgurol' Alıntı:
Sayın Orion1;
Çok teşekkür ederim.Evet istediğim gibi olmuş.Liste kısmına buton ekledim denedim.Çok güzel gerçekten,ben bu işlemi tek tek bakıp yapıyordum o açıdan çok kullanışlı oldu benim için..yalnız "C2" hücresine değer yazmıyor.Yoksa ben mi yanlış birşeyler yapıyorum?
Genişletmek için tıkla ...
Gerekli düzenlemeyi yaptım.3 nolu mesajdan dosyayı indirebilirsiniz.:cool:
 
Sayın Orion1;

Çok ama çok teşekkür ederim..Üstadım,emeğinize sağlık.Son bir ricada bulunsam listeye bir kaç arama kriteri eklemek istesem benim yapma şansım ne kadar bilmiyorum.:-( Ama inanın çok mutlu oldum.Saolun:-)
 
yesimgurol' Alıntı:
Sayın Orion1;

Çok ama çok teşekkür ederim..Üstadım,emeğinize sağlık.Son bir ricada bulunsam listeye bir kaç arama kriteri eklemek istesem benim yapma şansım ne kadar bilmiyorum.:-( Ama inanın çok mutlu oldum.Saolun:-)
Genişletmek için tıkla ...
Söyleyin yapayım.:cool:
 
Sayın Orion1;

Listeye 2 sütun ekledim umarım anlatabildim.Sizin için çok kolay olsa gerek..Çoo teşekkür ederim.
 

Ekli dosyalar

Bir açıklama yapmamışsınız ama ben yinede yaptım.
,Dosyanız ektedir.:cool:
Kod: 
Sub kapaliexcel_59()
Dim dosya As String, dsy As String, i As Long, sat As Long
Dim myrng, deg, deg2, yas
Range("B3:E" & Rows.Count).ClearContents
sat = 3
dosya = Dir(ThisWorkbook.Path & "\*.xls")
Do While dosya <> ""
    If dosya <> ThisWorkbook.Name Then
        dsy = dosya
        deg = Application.ExecuteExcel4Macro("'" & ThisWorkbook.Path & _
        "\[" & dsy & "]RAPOR'!r86c3")
        If deg > 5 Then
            deg2 = Application.ExecuteExcel4Macro("'" & ThisWorkbook.Path & _
            "\[" & dsy & "]RAPOR'!r44c6")
            yas = Application.ExecuteExcel4Macro("'" & ThisWorkbook.Path & _
            "\[" & dsy & "]RAPOR'!r12c2")
            Cells(sat, "B").Value = deg
            Cells(sat, "C").Value = deg2
            Cells(sat, "D").Value = yas
            Cells(sat, "E").Value = deg2
            sat = sat + 1
        End If
    End If
    dosya = Dir
Loop
MsgBox "İşlem Tamamlandı." & vbLf & "evrengizlen@hotmail.com", vbOKOnly + vbInformation
End Sub
 

Ekli dosyalar

Sayın Orion1;

Kusura bakmayın vaktinizi alıyorum.Müsaitseniz en son eklediğim listeye ekleme yapmıştım,bakabilir misiniz?
 
Pardon son mesajımı dikkate almayın.Çok teşekkür ederim..
 
Sayın Orion1; kısa bir sorum daha olacaktı..Acaba değerleri aldığımız excelde yapılan raporlar, word belgesi olsaydı yine aynı şekilde exceldeki listeye bilgileri alabilirmiydik?
 
Sayın Orion 1;

Sayın Orion 1;

Kusura bakmayın, çok mesaj yazıyorum.Çalışınca yeni yeni sorunlar çıkıyor.İşin içinden çıkamıyorum:-(

Ekte "Liste" sayfasında eklemek istediğim 3 sütun için açıklama yapmaya çalıştım.O istenilen bilgiler doğrultusunda , yapmış olduğunuz makroyu Listede ki gibi son olarak düzenleme imkanınız olur mu?
 

Ekli dosyalar

Dosyanız ektedir.:cool:
Kod: 
Sub kapaliexcel_59()
Dim dosya As String, dsy As String, i As Long, sat As Long
Dim myrng, deg, deg2, yas, bakir, dmsa
Range("B3:G" & Rows.Count).ClearContents
sat = 3
dosya = Dir(ThisWorkbook.Path & "\*.xls")
Do While dosya <> ""
    If dosya <> ThisWorkbook.Name Then
        dsy = dosya
        deg = Application.ExecuteExcel4Macro("'" & ThisWorkbook.Path & _
        "\[" & dsy & "]RAPOR'!r86c3")
        If deg > 5 Then
            deg2 = Application.ExecuteExcel4Macro("'" & ThisWorkbook.Path & _
            "\[" & dsy & "]RAPOR'!r76c3")
            yas = Application.ExecuteExcel4Macro("'" & ThisWorkbook.Path & _
            "\[" & dsy & "]RAPOR'!r84c3")
            bakir = Application.ExecuteExcel4Macro("'" & ThisWorkbook.Path & _
            "\[" & dsy & "]RAPOR'!r31c3")
            dmsa = Application.ExecuteExcel4Macro("'" & ThisWorkbook.Path & _
            "\[" & dsy & "]RAPOR'!r44c6")
            yas2 = Application.ExecuteExcel4Macro("'" & ThisWorkbook.Path & _
            "\[" & dsy & "]RAPOR'!r12c2")
            Cells(sat, "B").Value = deg
            If deg2 > 60 Then Cells(sat, "C").Value = deg2
            If yas > 5 Then Cells(sat, "D").Value = yas
            If bakir > 0.12 Then Cells(sat, "E").Value = bakir
            Cells(sat, "F").Value = dmsa
            Cells(sat, "G").Value = yas2
            sat = sat + 1
        End If
    End If
    dosya = Dir
Loop
MsgBox "İşlem Tamamlandı." & vbLf & "evrengizlen@hotmail.com", _
vbOKOnly + vbInformation, Application.UserName
End Sub
 

Ekli dosyalar

Sayın Orion 1;

Sayın Hocam Listede bulunan ; "E" Sütununa Rapordaki ""C31" (0.12 den büyük ise) ; "F" sütununa rapordaki "F44" ;"G" sütununa yine rapordaki "B12" değerlerinin olması lazımdı,denedim olmadı da..Bir yerde yanlış mı yapıyorum?
 
yesimgurol' Alıntı:
Sayın Orion 1;

Sayın Hocam Listede bulunan ; "E" Sütununa Rapordaki ""C31" (0.12 den büyük ise) ; "F" sütununa rapordaki "F44" ;"G" sütununa yine rapordaki "B12" değerlerinin olması lazımdı,denedim olmadı da..Bir yerde yanlış mı yapıyorum?
Genişletmek için tıkla ...
Gerekli düzeltmeyi yaptım 12 nolu mesajdan dosyanızı indirebilrisiniz.:cool:
 
Sayın Hocam ; emeğinize sağlık...ALLAH SEVDİKLERİNİZLE BİRLİKTE UZUN ÖMÜRLER VERSİN..

Tam istediğim gibi yaptınız..Çok teşekkür ederim..

..ve bu siteyi kurmada emeği geçen herkese çok teşekkür ederim.İyi çalışmalar.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst