dosya adı hücre adına eşitse değer atamasını sağlama

[kerim5555]

Merhaba;

Örneğin; B3 hücresinin toroslar ve B1 hücresindeki veri olarak ad olan dosya varsa (örnek toroslar 11.10.2017) bu dosyadaki B3 değerini yazmazını istiyorum. Yani B3 hücresinde toroslar 11.10.2017 dosyasındaki "555" değerini yazmasını istiyorum. öyle bir dosya yoksa "GELMEDİ" yazmasını istiyorum.

Örnek dosya Ek'tedir. Şimdiden teşekkür ederim.

 

[Asri]

Aşağıdaki şekilde deneyiniz.

toroslar mavi komut ile, okunacak satır ve sütun kırmızı komut ile alınmaktadır.

Sub verial()
    Dim dosya As String
    dosya = ActiveWorkbook.Path & "\" & [COLOR=Blue]Cells(2, "B").Value[/COLOR] & " " & Cells(1, "B").Value & ".xlsx"
    bilgi = "'" & ActiveWorkbook.Path & "\[" & [COLOR=Blue]Cells(2, "B").Value[/COLOR] & " " & Cells(1, "B").Value & ".xlsx]" & "Sayfa1'![COLOR=Red]R3C2[/COLOR]"
    If dosyavarmi(dosya) Then
      Cells(3, "B").Value = Application.ExecuteExcel4Macro(bilgi)
    Else
      Cells(3, "B").Value = "Gelmedi"
    End If
End Sub

Function dosyavarmi(dosya)
    Dim ds, a
    Set ds = CreateObject("Scripting.FileSystemObject")
    a = ds.FileExists(dosya)
    If a = True Then
    dosyavarmi = True
    Else
    dosyavarmi = False
    End If
End Function