• DİKKAT

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

Dosya yolu yazarken dosyanın adına ay ve gün nasıl eklenir

Z

zeynepozo

Katılım
19 Eylül 2007
Mesajlar
14
Excel Vers. ve Dili
office 2007
Merhaba,


tarih|giriş|çıkış|devir sutünları olan bir dosyam var.
Tarih A2 hücresinde 01/07/2020 olarak yazmaktadır. ve bugüne kadar gelmektedir.
Ayrıca her ay için ayrı bir xls dosyam bulunmakta ve her dosyada 1-31 e kadar gün sayısı kadar sayfa vardır. ben bu tarih sütununda yazılı olan tarihin ay ve o ayın günlerindeki verileri ilgili sayfadan getirmek istiyorum.

yani;

A2 hücresinde 1/7/2020 için ---> 7.xls temmuz ayı dosyasının, 1.gün sayfasındaki I20 hücresindeki değeri,
A3 hücresinde 2/7/2020 için ---> 7.xls temmuz ayı dosyasının, 2.gün sayfasındaki I20 hücresindeki değeri,
A4 hücresinde 3/7/2020 için ---> 7.xls temmuz ayı dosyasının, 3.gün sayfasındaki I20 hücresindeki değeri,
.....
A32 hücresinde 31/7/2020 için ---> 7.xls temmuz ayı dosyasının, 31.gün sayfasındaki I20 hücresindeki değeri,

A33 hücresinde 1/8/2020 için ---> 8.xls ağustos ayı dosyasının, 1.gün sayfasındaki I20 hücresindeki değeri,
A34 hücresinde 2/8/2020 için ---> 8.xls ağustos ayı dosyasının, 2.gün sayfasındaki I20 hücresindeki değeri,​

​
='[7.xlsx]1'!$I$20
='[7.xlsx]2'!$I$20
='[7.xlsx]3'!$I$20
...
='[7.xlsx]31'!$I$20
='[8.xlsx]1'!$I$20
='[8.xlsx]2'!$I$20


="'["&AY(A2)&".xlsx]"&GÜN(A2)&"'!"&$I$20


gibi yazıyorum ama ekrana formülü basıyor sadece. yardımcı olabilir misiniz?

 
Merhaba,

DOLAYLI fonksiyonu ile çözüme gidebilirsiniz. Fakat bu fonksiyonda kapalı dosyalarda çalışmamaktadır.

En uygun çözüm makro kullanmanızdır.
 
Örnek dosyalarınızı paylaşmanız gerekiyor.
 
Dosyalarınız aynı klasör içinde olsun.

Kodu "Günlük Kasa Hareket Raporu" isimli dosyanızda çalıştırıp deneyiniz. Dosyanızı kaydederken kodların silinmemesi için "Makro İçerebilen Excel Çalışma Kitabı" biçimiyle kaydediniz.

C++: 
Option Explicit

Sub Gunluk_Kasa_Verilerini_Aktar()
    Dim Zaman As Double, S1 As Worksheet, Yol As String
    Dim Son As Long, Veri As Variant, X As Long, Say As Long
    Dim Y As Long, Ay As Byte, Dosya As String
    Dim Aranan_Gun As Byte, Gun As Worksheet
    
    Zaman = Timer
   
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
   
    Set S1 = Sheets("Günlük Kasa Hareket Raporu")
   
    S1.Range("B2:C" & S1.Rows.Count).ClearContents
   
    Yol = ThisWorkbook.Path & "\"
    
    Son = S1.Cells(S1.Rows.Count, 1).End(3).Row
    
    If Son = 1 Then
        Application.Calculation = xlCalculationAutomatic
        Application.ScreenUpdating = True
        MsgBox "Lütfen önce A sütununa tarih girişi yapınız." & vbLf & vbLf & _
               "İşleminiz sonlandırılmıştır.", vbCritical
        GoTo 10
    End If
    
    If Son = 2 Then
        Veri = S1.Cells(2, 1).Value
        Ay = Month(Veri)
        Dosya = Dir(Yol & Ay & ".xls*")
        
        If Dosya <> "" Then
            GetObject (Yol & Dosya)
            Aranan_Gun = Day(Veri)
            On Error Resume Next
            Set Gun = Nothing
            Set Gun = Workbooks(Dosya).Sheets(CStr(Aranan_Gun))
            On Error Resume Next
            
            If Not Gun Is Nothing Then
                S1.Cells(2, 2) = Gun.Range("I25").Value
                S1.Cells(2, 3) = Gun.Range("D25").Value
                Workbooks(Dosya).Close 0
                Application.Calculation = xlCalculationAutomatic
                Application.ScreenUpdating = True
                MsgBox "Veri aktarımı tamamlanmıştır." & vbLf & vbLf & _
                       "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye"
            Else
                Workbooks(Dosya).Close 0
                MsgBox "Aktarılacak veri bulunamadı!", vbExclamation
            End If
        End If
    
    Else
    
        Veri = S1.Range("A2:A" & Son).Value
        
        ReDim Liste(1 To Son, 1 To 2)
        
        For X = LBound(Veri, 1) To UBound(Veri, 1)
            If Veri(X, 1) = "" Then
                Say = Say + 1
                Liste(Say, 1) = Empty
                Liste(Say, 2) = Empty
            Else
                Ay = Month(Veri(X, 1))
                Dosya = Dir(Yol & Ay & ".xls*")
                
                If Dosya <> "" Then
                    GetObject (Yol & Dosya)
                    For Y = X To UBound(Veri, 1)
                        If Ay <> Month(Veri(Y, 1)) Then
                            X = Y - 1
                            Exit For
                        End If
                        Aranan_Gun = Day(Veri(Y, 1))
                        On Error Resume Next
                        Set Gun = Nothing
                        Set Gun = Workbooks(Dosya).Sheets(CStr(Aranan_Gun))
                        On Error Resume Next
                        
                        Say = Say + 1
                        
                        If Not Gun Is Nothing Then
                            Liste(Say, 1) = Gun.Range("I25").Value
                            Liste(Say, 2) = Gun.Range("D25").Value
                        End If
                        
                    Next
                    Workbooks(Dosya).Close 0
                End If
            End If
        Next
           
        If Say > 0 Then
            S1.Range("B2").Resize(Say, 2) = Liste
            Application.Calculation = xlCalculationAutomatic
            Application.ScreenUpdating = True
            MsgBox "Veri aktarımı tamamlanmıştır." & vbLf & vbLf & _
                   "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye"
        Else
            MsgBox "Aktarılacak veri bulunamadı!", vbExclamation
        End If
    End If
       
10  Set Gun = Nothing
    Set S1 = Nothing
End Sub
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst