Makro revize

T

tahsinanarat

Altın Üye
Katılım
14 Mart 2005
Mesajlar
2,167
Excel Vers. ve Dili
Ofis 2019 Türkçe
Altın Üyelik Bitiş Tarihi
27-05-2028
Sn. @Korhan Ayhan Kodlar gayet hızlı elinize sağlık,
Veri(X, Y + 2) = "Var" yazan yere;
Veri(X, Y + 2) = Dosya olarak değiştirdiğimde Dosya isimleri gelebiliyor, Buna Hyperlink atayabilirmiyiz, üzerine bastığımızda dosya açılsın.
Teşekkür ederim.
 
Korhan Ayhan

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
42,295
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Aşağıdaki kodu deneyiniz.

Kod klasördeki dosyaları sorgulayıp eğer varsa dosya adını yazar ve ilgili dosyaya link oluşturur. (Hyperlink)

Bir karışıklık olmaması adına koda sayfa tanımlaması da ekledim.

C++: 
Option Explicit

Sub TC_Kimlik_No_Kontrol()
    Dim S1 As Worksheet, Veri As Variant, Klasor As Variant, Uzanti As Variant
    Dim X As Long, Y As Byte, Son As Long, Dosya As String, Zaman As Double
   
    Zaman = Timer
   
    Application.ScreenUpdating = False
   
    Set S1 = Sheets("Sheet1")
   
    Klasor = Array("C:\FOTO\", "C:\NUFUS\", "C:\OGKK_PDF\", "C:\SGK YENI\")
    Uzanti = Array(".jpg", ".pdf", ".pdf", ".pdf")
   
    Son = S1.Cells(S1.Rows.Count, 1).End(3).Row
    Veri = S1.Range("A2:E" & Son).Value2
    S1.Range("B2:E" & S1.Rows.Count).Clear
   
    For X = LBound(Veri) To UBound(Veri)
        If Veri(X, 1) <> "" Then
            For Y = LBound(Klasor) To UBound(Klasor)
                Dosya = Dir(Klasor(Y) & Veri(X, 1) & "*" & Uzanti(Y))
                If Dosya <> "" Then
                    Veri(X, Y + 2) = Dosya
                    S1.Hyperlinks.Add Anchor:=S1.Cells(X + 1, Y + 2), _
                    Address:=Klasor(Y) & Dosya, TextToDisplay:=Dosya
                Else
                    Veri(X, Y + 2) = "Yok"
                End If
            Next
        End If
    Next

    S1.Range("A2").Resize(UBound(Veri, 1), UBound(Veri, 2)) = Veri

    Application.ScreenUpdating = True

    MsgBox "İşleminiz tamamlanmıştır." & Chr(10) & Chr(10) & _
           "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye"
End Sub
 
T

tahsinanarat

Altın Üye
Katılım
14 Mart 2005
Mesajlar
2,167
Excel Vers. ve Dili
Ofis 2019 Türkçe
Altın Üyelik Bitiş Tarihi
27-05-2028
Sn. @Korhan Ayhan Hocam, aradığım tam olarak bu, elinize kolunuza sağlık, hakkınızı helal edin, bayağı uğraştırdık ama çok faydalı bir kod oldu. Eminim bundan faydalanacak çok form üyesi arkadaşım olacaktır. Allah sizden razı olsun.
 
Korhan Ayhan

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
42,295
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Güle güle kullanın...

İÇERİR mantığı ile çalışan daha hızlı bir yapı bulursam onu da paylaşırım.
 
M

metin_0606

Katılım
1 Ağustos 2019
Mesajlar
839
Excel Vers. ve Dili
Türkçe excel 2016
İngilizce excel 2016
Altın Üyelik Bitiş Tarihi
19-10-2021
Korhan Ayhan' Alıntı:
Aşağıdaki kodu deneyiniz.

Kod klasördeki dosyaları sorgulayıp eğer varsa dosya adını yazar ve ilgili dosyaya link oluşturur. (Hyperlink)

Bir karışıklık olmaması adına koda sayfa tanımlaması da ekledim.

C++: 
Option Explicit

Sub TC_Kimlik_No_Kontrol()
    Dim S1 As Worksheet, Veri As Variant, Klasor As Variant, Uzanti As Variant
    Dim X As Long, Y As Byte, Son As Long, Dosya As String, Zaman As Double
  
    Zaman = Timer
  
    Application.ScreenUpdating = False
  
    Set S1 = Sheets("Sheet1")
  
    Klasor = Array("C:\FOTO\", "C:\NUFUS\", "C:\OGKK_PDF\", "C:\SGK YENI\")
    Uzanti = Array(".jpg", ".pdf", ".pdf", ".pdf")
  
    Son = S1.Cells(S1.Rows.Count, 1).End(3).Row
    Veri = S1.Range("A2:E" & Son).Value2
    S1.Range("B2:E" & S1.Rows.Count).Clear
  
    For X = LBound(Veri) To UBound(Veri)
        If Veri(X, 1) <> "" Then
            For Y = LBound(Klasor) To UBound(Klasor)
                Dosya = Dir(Klasor(Y) & Veri(X, 1) & "*" & Uzanti(Y))
                If Dosya <> "" Then
                    Veri(X, Y + 2) = Dosya
                    S1.Hyperlinks.Add Anchor:=S1.Cells(X + 1, Y + 2), _
                    Address:=Klasor(Y) & Dosya, TextToDisplay:=Dosya
                Else
                    Veri(X, Y + 2) = "Yok"
                End If
            Next
        End If
    Next

    S1.Range("A2").Resize(UBound(Veri, 1), UBound(Veri, 2)) = Veri

    Application.ScreenUpdating = True

    MsgBox "İşleminiz tamamlanmıştır." & Chr(10) & Chr(10) & _
           "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye"
End Sub
Genişletmek için tıkla ...
Bu makroyu ekte sunduğum çalışma sayfasına uyarlayabilirmiyiz korhan bey uğraştım ama olmadı bir türlü
 

Ekli dosyalar

T

tahsinanarat

Altın Üye
Katılım
14 Mart 2005
Mesajlar
2,167
Excel Vers. ve Dili
Ofis 2019 Türkçe
Altın Üyelik Bitiş Tarihi
27-05-2028
Korhan Hocamın affına sağınarak; bu şekilde deneyin.

Kod: 
Option Explicit

Sub TC_Kimlik_No_Kontrol()
    Dim S1 As Worksheet, Veri As Variant, Klasor As Variant, Uzanti As Variant
    Dim X As Long, Y As Byte, Son As Long, Dosya As String, Zaman As Double

    Zaman = Timer

    Application.ScreenUpdating = False

    Set S1 = Sheets("Sayfa1")

    Klasor = Array("C:\FOTO\", "C:\NUFUS\", "C:\OGKK_PDF\", "C:\SGK YENI\")
    Uzanti = Array(".jpg", ".pdf", ".pdf", ".pdf")

    Son = S1.Cells(S1.Rows.Count, 1).End(3).Row
    Veri = S1.Range("A2:G" & Son).Value2
    S1.Range("D2:G" & S1.Rows.Count).Clear

    For X = LBound(Veri) To UBound(Veri)
        If Veri(X, 2) <> "" Then
            For Y = LBound(Klasor) To UBound(Klasor)
                Dosya = Dir(Klasor(Y) & Veri(X, 2) & "*" & Uzanti(Y))
                If Dosya <> "" Then
                    Veri(X, Y + 4) = Dosya
                    S1.Hyperlinks.Add Anchor:=S1.Cells(X + 1, Y + 4), _
                    Address:=Klasor(Y) & Dosya, TextToDisplay:=Dosya
                Else
                    Veri(X, Y + 4) = "Yok"
                End If
            Next
        End If
    Next

    S1.Range("A2").Resize(UBound(Veri, 1), UBound(Veri, 2)) = Veri

    Application.ScreenUpdating = True

    MsgBox "İşleminiz tamamlanmıştır." & Chr(10) & Chr(10) & _
           "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye"
End Sub
 
M

metin_0606

Katılım
1 Ağustos 2019
Mesajlar
839
Excel Vers. ve Dili
Türkçe excel 2016
İngilizce excel 2016
Altın Üyelik Bitiş Tarihi
19-10-2021
tahsinanarat' Alıntı:
Korhan Hocamın affına sağınarak; bu şekilde deneyin.

Kod: 
Option Explicit

Sub TC_Kimlik_No_Kontrol()
    Dim S1 As Worksheet, Veri As Variant, Klasor As Variant, Uzanti As Variant
    Dim X As Long, Y As Byte, Son As Long, Dosya As String, Zaman As Double

    Zaman = Timer

    Application.ScreenUpdating = False

    Set S1 = Sheets("Sayfa1")

    Klasor = Array("C:\FOTO\", "C:\NUFUS\", "C:\OGKK_PDF\", "C:\SGK YENI\")
    Uzanti = Array(".jpg", ".pdf", ".pdf", ".pdf")

    Son = S1.Cells(S1.Rows.Count, 1).End(3).Row
    Veri = S1.Range("A2:G" & Son).Value2
    S1.Range("D2:G" & S1.Rows.Count).Clear

    For X = LBound(Veri) To UBound(Veri)
        If Veri(X, 2) <> "" Then
            For Y = LBound(Klasor) To UBound(Klasor)
                Dosya = Dir(Klasor(Y) & Veri(X, 2) & "*" & Uzanti(Y))
                If Dosya <> "" Then
                    Veri(X, Y + 4) = Dosya
                    S1.Hyperlinks.Add Anchor:=S1.Cells(X + 1, Y + 4), _
                    Address:=Klasor(Y) & Dosya, TextToDisplay:=Dosya
                Else
                    Veri(X, Y + 4) = "Yok"
                End If
            Next
        End If
    Next

    S1.Range("A2").Resize(UBound(Veri, 1), UBound(Veri, 2)) = Veri

    Application.ScreenUpdating = True

    MsgBox "İşleminiz tamamlanmıştır." & Chr(10) & Chr(10) & _
           "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye"
End Sub
Genişletmek için tıkla ...
teşekkürler tahsin bey istediğim gibi oldu sağlıcakla
 
T

tahsinanarat

Altın Üye
Katılım
14 Mart 2005
Mesajlar
2,167
Excel Vers. ve Dili
Ofis 2019 Türkçe
Altın Üyelik Bitiş Tarihi
27-05-2028
Sn. @Korhan Ayhan hocam ;
C:\SGK YENI\
Klasörünün altında branşlara göre alt klasörler oluşturmak zorunda kaldım. Bu nedenle liste alıp link verirken alt klasörleri de listelemesi ve link vermesini istiyorum. Yardımlarınız için şimdiden teşekkür ederim.
 
T

tahsinanarat

Altın Üye
Katılım
14 Mart 2005
Mesajlar
2,167
Excel Vers. ve Dili
Ofis 2019 Türkçe
Altın Üyelik Bitiş Tarihi
27-05-2028
Güncel
 
T

TURKOLOG

Altın Üye
Katılım
13 Kasım 2008
Mesajlar
744
Excel Vers. ve Dili
2016 64 TR
Altın Üyelik Bitiş Tarihi
29-10-2026
Peki misal PASİF_İŞLEMLERİ sayfasının
G sütununda mailler var
F ,K,N sütunlarında ise uzantıları ile birlikte dosya yılları var her veri eklediğinde hyperlink olsa
Sayfanın kod bölümüne ne yazsak yazar yazmaz hyperlink yapsa
 
Cevap yazmak için giriş yap yada kayıt ol.
Üst