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

[zeynepozo]

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?

 

[zeynepozo]

İmkansız birşey mi istemişim?

 

[Korhan Ayhan]

Merhaba,

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

En uygun çözüm makro kullanmanızdır.

 

[zeynepozo]

Makro konusunda yardımcı olabilir misiniz?

 

[Korhan Ayhan]

Örnek dosyalarınızı paylaşmanız gerekiyor.

 

[zeynepozo]

Dosyalar ektedir. çok teşekkürler.

 

[Korhan Ayhan]

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.

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