• DİKKAT

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

Kapalı Dosyadan Veri Alma / Alt Klasörleri olan dizin

W

walabi

Altın Üye
Katılım
22 Eylül 2012
Mesajlar
1,080
Excel Vers. ve Dili
excel 2010

excel 2013
Merhaba,

Ekteki gibi bir rapor çalışmasının olduğu excel kitabının olduğu klasörde dönemsel alt klasörler mevcut. Bu rapor çalışmasına alt klasörlerdeki excel kitaplarındaki Raporlama Verisi ( bu sayfa ve verisi sabit ) adlı sayfadaki B1 hücre değerini Tesis-Dönem karşılaştırmalı olarak rapora yansıtmak istiyorum. Nasıl yapabilirim. Örnek dosya üzerinde alt klasörlerde oluşturulan dosya isimlerinin örnek adları mevcut.
 

Ekli dosyalar

Açtığım konu ile ilgili destek almam mümkün mü. Başlangıç adımı arıyorum açıkcası.
 
Açtığım bu konu ile ilgili olarak kendim bir noktaya geldim. Şöylesi bir çözüme ihtiyacım var.

Olmayan bir dosya varsa kod çalışmayacak şekilde nasıl bir kod satırı eklemem gerekir.

Dir komutu adlı bir konu buldum ancak tam anlamadım.

Koda şunu yaptırmam gerekiyor. Dosya varsa şunu yap, dosya yoksa işlem yapma gibi.

Kod: 
Sub Deneme()
Dim s1 As Worksheet
Dim s2 As Worksheet
Dim Sabit_Parca1 As String
Dim Sabit_Parca2 As String
Dim Sabit_Parca3 As String
Dim Sabit_Parca4 As String

Dim Yol As String
Dim Dosya As String
Set s1 = Sheets("Rapor")


sonsatir = s1.Cells(Rows.Count, "A").End(3).Row
'sonsutun = s1.Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column

sonsutun = 5

Sabit_Parca1 = "\\-------------------Maliyet Çalışma\TESİSLER KAR-ZARAR MALİYET\"
Sabit_Parca2 = "2024\"
Sabit_Parca3 = ".xlsx]"
Sabit_Parca4 = "Raporlama Verisi'!$B$1"


s1.Range(s1.Cells(4, 4), s1.Cells(sonsatir, sonsutun)).ClearContents



For sutun = 4 To sonsutun
    For satir = 4 To sonsatir
   
   


    Dosya = "'" & Sabit_Parca1 & Sabit_Parca2 & s1.Cells(2, sutun) & "_" & s1.Cells(3, sutun) & "\[" & s1.Cells(satir, "B") & "_" & s1.Cells(satir, "C") & "_" & s1.Cells(2, sutun) & Sabit_Parca3
    Yol = "'" & Sabit_Parca1 & Sabit_Parca2 & s1.Cells(2, sutun) & "_" & s1.Cells(3, sutun) & "\[" & s1.Cells(satir, "B") & "_" & s1.Cells(satir, "C") & "_" & s1.Cells(2, sutun) & Sabit_Parca3 & Sabit_Parca4
   
 
    s1.Cells(satir, sutun) = "=" & Yol
   
   


    Next
Next


End Sub
 
Aşağıdaki gibi koşul verebilirsiniz.

C++: 
If Dir(Dosya_Tam_Yolu) = "" Then
   'Dosya yoksa bunları yap...
Else
   'Dosya varsa bunları yap...
End If
 
Korhan Ayhan' Alıntı:
Aşağıdaki gibi koşul verebilirsiniz.

C++: 
If Dir(Dosya_Tam_Yolu) = "" Then
   'Dosya yoksa bunları yap...
Else
   'Dosya varsa bunları yap...
End If
Genişletmek için tıkla ...


Korhan bey, bu mesajınızı başka bir konu üzerinde görmüştüm. Kendi kodlarıma uygulamaya çalıştım. Ancak kod hiç çalışmıyor gibi. Daha doğrusu dosyaların hiç biri yokmuş gibi. Oysaki aşağıda şekilde baktığım zaman önce veriler hücrelere yansıyor , Dir li yapıya soktuğum zaman ise hücre doğal olarak boş gösteriliyor. Sebebini anlamadım. Tam_Dosya_Yolu şeklinde vurgulamışsınız. Dosya yolu hiç bir şekilde doğru olmasa dosyaya sayısal veriler yansımaz sanırım diye düşünüyorum. Eksik olan ne anlamadım.

Kod: 
For sutun = 4 To sonsutun
    For satir = 4 To sonsatir
    
    


    Dosya = "'" & Sabit_Parca1 & Sabit_Parca2 & s1.Cells(2, sutun) & "_" & s1.Cells(3, sutun) & "\[" & s1.Cells(satir, "B") & "_" & s1.Cells(satir, "C") & "_" & s1.Cells(2, sutun) & Sabit_Parca3
    Yol = "'" & Sabit_Parca1 & Sabit_Parca2 & s1.Cells(2, sutun) & "_" & s1.Cells(3, sutun) & "\[" & s1.Cells(satir, "B") & "_" & s1.Cells(satir, "C") & "_" & s1.Cells(2, sutun) & Sabit_Parca3 & Sabit_Parca4
    
    s1.Cells(satir, sutun) = "=" & Yol
  
    
    MsgBox "Kontrol"
    
    If Dir(Dosya) = "" Then
    s1.Cells(satir, sutun) = ""
    Else
    s1.Cells(satir, sutun) = "=" & Yol
    End If


    Next
Next
 
Dosya yolunda köşeli parantez olmaz... Bunu düzeltip deneme yapınız...
 
s1.Cells(satir, sutun) = "=" & Yol bu kod satırı ile alt klasörlerdeki excel kitaplarından verileri getirebiliyorum. Ancak değer olarak değil dosya yolu olarak. Daha sonra hücrede oluşan sonucu kopyala-özel yapıştır-değer şeklinde değiştiriyorum. Dosya yolundan formül ile hücreye yansıyan sonucu sadece değer olarak direk almam mümkün mü? Application.ExecuteExcel4Macro(Yol) böylesi bir kod satırına rasladım ama çözemedim ne olduğunu

Kod: 
    If WorksheetFunction.CountIf(s1.Cells(satir, "C"), "*" & "TOPLAM" & "*") = 0 Then ' toplam içermeyen satırları belirler
    
    Dosya_Yolu = Sabit_Parca1 & s1.Cells(2, 2) & Sabit_Parca2 & s1.Cells(2, sutun) & "_" & s1.Cells(3, sutun) & "\" & s1.Cells(satir, "B") & "_" & s1.Cells(satir, "C") & "_" & s1.Cells(2, sutun) & Sabit_Parca5
    Yol = "'" & Sabit_Parca1 & s1.Cells(2, 2) & Sabit_Parca2 & s1.Cells(2, sutun) & "_" & s1.Cells(3, sutun) & "\[" & s1.Cells(satir, "B") & "_" & s1.Cells(satir, "C") & "_" & s1.Cells(2, sutun) & Sabit_Parca3 & Sabit_Parca4
    
    s1.Cells(satir, sutun) = ""
    
    If Dir(Dosya_Yolu) = "" Then
    's1.Cells(satir, sutun) = ""
    'MsgBox "Dosya Yok"
    Else
    'MsgBox "Dosya Var"
    'deg = Application.ExecuteExcel4Macro(Yol)
    s1.Cells(satir, sutun) = "=" & Yol
    s1.Cells(satir, sutun).Select
    Selection.Copy
    s1.Cells(satir, sutun).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    s1.Cells(satir, sutun) = WorksheetFunction.Round(s1.Cells(satir, sutun), 2)
    End If
    
    
    End If
    Next
    Next
 
Application.ExecuteExcel4Macro metodu biraz yavaş çalışır. Kullanmak isterseniz forumda daha önce örnekler paylaşıldı. Onları inceleyip denemeler yaparak sonuca gidebilirsiniz.

Dilerseniz linklerdeki teknikleri inceleyebilirsiniz.

Kapalı Dosyadan Koşullu Veri Çekme

Değerli Forum üyeleri Açık kitap isimli çalışma kitabımın B sütununda yazılı olan TC kimlik numaralarını Kapalı kitapta bulup buradaki ilgili TC kimlik numaralarına ait tarihleri Açık kitaptaki TC kimlik numaralarının karşısına Tarih2 sütununa getirip, Tarih 1 ve Tarih 2 sütunlarındaki...
www.excel.web.tr www.excel.web.tr

Ado ile Hücre değerlerine göre sonuç getirme

Merhaba, Eklediğim dosya da sayfa2 de örnek veriler var. Sayfa1 de ise yanına sonuç getirmeye çalıştığım değerler var. özetle ado ile düşeyara yapmak istiyorum ado ile döngü yapılabiliyormu veya selection.change ile çözüm bulabilirmiyim diye bir kaç zamandır araştırdım ama sonuç elde edemedim...
www.excel.web.tr www.excel.web.tr

Farklı Dosyadan Arama Yapma-Aktarma,

Merhaba; Bir klasörüm içerisinde 2 adet excel dosyası bulunmaktadır. Biri kapalı diğeri ise açık durumda iken dosyada arama yapma ve kapalı dosyadaki bilgilerin açık olan sayfaya aktarmasını istiyorum. Nasıl yapılabilir. Dosya: Ara Aktar
www.excel.web.tr www.excel.web.tr
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst