Dosya yolunu tanımlama

[dengeceteris]

Sevgili Forum yöneticileri herkese iyi günler. Bir tanımlama hakkında bilgi almak istiyorum. Geçenlerde sormuştum ama cevap veren çıkmadı bir kere daha şansımı deneyeyim istedim yardımcı olan olursa sevinirim.) ANALİZ isminde bir klasörüm var. Bu klasörün için de birisi VERİ diğeri HEDEF isminde 2 tane excel dosyam var. Ben HEDEF dosyamın içinde yan yana bulunan iki ayrı sayfamdan birinden diğerine kopyalama yaparken aşağıdaki gibi bir tanımlama ve formül kullanıyorum. Aşağıda kullandığım yapı benim bu forumdan iyi kötü öğrendiğim şeyler epeycede işimi görüyor. Ama yapmaya çalıştığım ise HEDEF dosyamın içinde ki veri sayfasını VERİ isimli çalışma kitabına alıp aynı işlemi farklı bir çalışma kitabında transfer şeklinde yapmak istiyorum. (Çünkü veri sayfam fazlaca büyük ve istediğim şeyleri alıp daha hızlı çalışmak istiyorum) Burada döngüyü sayfa tanımlamalarını öğrendim aynı çalışma kitabında bunları yapabiliyorum. Ancak diğer kısmı için yardım istiyorum.

Sub HEDEF()
Dim x As Double
Dim s1 As Worksheet, s2 As Worksheet, son As Double (Çalışma kitabı tanımlama nasıl yapılır)

Set s1 = Sheets("VERİ") (ANALİZ isimli klasörün içindeki VERİ isimli dosyada aynı isimdeki sayfadan getirtmek), (Çalışma kitabını set etmek)
Set s2 = Sheets("HEDEF")

son = s1.Cells(s1.Rows.Count, 1).End(xlUp).Row
s2.Range("A2:I" & Rows.Count).ClearContents

For x = 2 To son
If s1.Cells(x, 1)) <> "" Then (Buraları nasıl yazmam gerekir)
s2.Cells(x, 1) = Month(s1.Cells(x, 3))
s2.Cells(x, 2) = s1.Cells(x, 3)
s2.Cells(x, 3) = Left(s1.Cells(x, 1), 3)
s2.Cells(x, 4) = s1.Cells(x, 2)
s2.Cells(x, 5) = s1.Cells(x, 7)
s2.Cells(x, 6) = s1.Cells(x, 8)
End If
Next
End Sub

 

[Korhan Ayhan]

Aşağıdaki gibi kullanabilirsiniz.

Sub Kitap_ve_Sayfa_Tanimlama()
    Dim K1 As Workbook, S1 As Worksheet

    Set K1 = Workbooks.Open("C:\ANALİZ\HEDEF.xlsm", False, False)
    Set S1 = K1.Sheets("veri")
End Sub

 

[dengeceteris]

Korhan bey HEDEF dosyasının içini aşağıdaki şekilde düzenledim. Çalışmaya başlayınca Önce VERİ dosyasını açıyor ama Set s2 = Sheets("HEDEF") burada takılıyor.
Sub HEDEF()
Dim x As Double
Dim K1 As Workbook
Dim s1 As Worksheet, s2 As Worksheet, son As Double

Set K1 = Workbooks.Open("C:\Users\admin\Desktop\ANALİZ\VERİ.xlsm", False, False) (Kaynak kitabım)
Set s1 = K1.Sheets("VERİ") (Kaynak Sayfam)
Set s2 = Sheets("HEDEF") (Verileri kopyalamak istediğim dosya ve sayfanın ismi) (Her ikiside aynı isimde)

son = s1.Cells(s1.Rows.Count, 1).End(xlUp).Row
s2.Range("A2:I" & Rows.Count).ClearContents
For x = 2 To son
If s1.Cells(x, 1) <> "" Then
s2.Cells(x, 1) = Month(s1.Cells(x, 3))
s2.Cells(x, 2) = s1.Cells(x, 3)
s2.Cells(x, 3) = Left(s1.Cells(x, 1), 3)
s2.Cells(x, 4) = s1.Cells(x, 2)
s2.Cells(x, 5) = s1.Cells(x, 7)
s2.Cells(x, 6) = s1.Cells(x, 8)
End If
Next
End Sub

 

[Korhan Ayhan]

Aşağıdaki yapıyı deneyiniz.

Option Explicit

Sub HEDEF()
    Dim K1 As Workbook, S1 As Worksheet
    Dim K2 As Workbook, S2 As Worksheet
   
    Set K1 = ThisWorkbook
    Set S1 = K1.Sheets("HEDEF")
    Set K2 = Workbooks.Open("C:\Users\admin\Desktop\ANALİZ\VERİ.xlsm", False, False)
    Set S2 = K2.Sheets("VERİ")
End Sub

 

[dengeceteris]

Korhan bey tşk ederim.

 

[dengeceteris]

Korhan bey bir şey daha sormak istiyorum bağışlayın lütfen . Dosyam aşağıdaki şekilde ve sorunsuz çalışıyor tşk ederim öncelikle. Şimdi biz kopyalamayı yaparken VERİ dosyasını açıyoruz peki bunu açtırmadan yapmak mümkün mü ? İkinci olarakta benim ANALİZ isimli klasörümden ANALİZ1, ANALİZ2 gibi epeyce var. HEDEF isimli çalışma kitabımda farklı isimlerde bu klasörlerin içinde mevcut. Böyle olunca ben bütün bu dosyaların içine girip tek tek bu yolları tanıtmak zorundamıyım başkaca bir yolu filan yok mudur bunun ? Mesela bir buton olsa ve dosya ve sayfa seçip sonrasında diğer şartları yerine getirse mümkün mü ?

Sub HEDEF()
Dim x As Double
Dim K1 As Workbook, K2 As Workbook
Dim s1 As Worksheet, s2 As Worksheet, son As Double, satir As Integer

Set K1 = Workbooks.Open("C:\Users\admin\Desktop\ANALİZ\VERİ.xlsm", False, False)
Set s1 = K1.Sheets("VERİ")
Set K2 = ThisWorkbook
Set s2 = K2.Sheets("HEDEF")

son = s1.Cells(s1.Rows.Count, 1).End(xlUp).Row
s2.Range("A2:I" & Rows.Count).ClearContents

For x = 2 To son
If s1.Cells(x, 1) <> "" Then
s2.Cells(x, 1) = Month(s1.Cells(x, 3))
s2.Cells(x, 2) = s1.Cells(x, 3)
s2.Cells(x, 3) = Left(s1.Cells(x, 1), 3)
s2.Cells(x, 4) = s1.Cells(x, 2)
s2.Cells(x, 5) = s1.Cells(x, 7)
s2.Cells(x, 6) = s1.Cells(x, 8)
End If
Next
End Sub

 

[Korhan Ayhan]

Dosyaları açtırmak zorunda değilsiniz.

Forumda onlarca kapalı dosyalardan veri alma kodları paylaşıldı. Arama yaparsanız ulaşabilirsiniz. (klasör yazarak arama yapabilirsiniz)

Kapalı dosyalardan veri almanız için dosyaların belirli kurallar çerçevesinde olması gerekiyor. Veri tabanı kayıt düzeni varsa veri almanız kolaylaşır. Aksi durumda bazı sorguların yazılması gerekebilir.

Fakat net cevap alabilmeniz için ANALİZ dosyalarından bir kaçını ve almak istediğini veri düzenini daha detaylı örnek vererek açıklamanız gerekiyor.

 

[dengeceteris]

Merhabalar;
Korhan bey dosyaları ekledim. Dün bahsettiğim gibi ANALİZ klasörümün içinde HEDEF ve VERİ isimli dosyalarım var ve ben VERİ dosyamın içinde bulunan VERİ sayfasından HEDEF isimli dosyama veri transfer ediyorum. İki şeyi yapmak istiyorum birincisi işlemi yaparken VERİ isimli dosyam açılmadan kapalı dosyadan veri çeksin. İkinci olarakta benim ANALİZ isimli klasörümden farklı isimerde çok fazla olduğu için sizin dün K1 olarak düzenlediğiniz dosya yolunu her defasında içeriye girip düzenlemek yerine farklı bir yol bulabilirmiyiz diye sormuştum. (dosya isimleri ve formatları bütün klasörlerde aynı)
Sub HEDEF()
Dim x As Double
Dim K1 As Workbook, K2 As Workbook
Dim s1 As Worksheet, s2 As Worksheet, son As Double, satir As Integer

Set K1 = Workbooks.Open("C:\Users\admin\Desktop\ANALİZ\VERİ.xlsm", False, False)
Set s1 = K1.Sheets("VERİ")
Set K2 = ThisWorkbook
Set s2 = K2.Sheets("HEDEF")
son = s1.Cells(s1.Rows.Count, 1).End(xlUp).Row
s2.Range("A2:I" & Rows.Count).ClearContents
For x = 2 To son

If s1.Cells(x, 1) <> "" Then
s2.Cells(x, 1) = Month(s1.Cells(x, 3))
s2.Cells(x, 2) = s1.Cells(x, 3)
s2.Cells(x, 3) = Left(s1.Cells(x, 1), 3)
s2.Cells(x, 4) = s1.Cells(x, 2)
s2.Cells(x, 5) = s1.Cells(x, 7)
s2.Cells(x, 6) = s1.Cells(x, 8)
End If
Next
End Sub

 

[dengeceteris]

Tekrar merhaba: Yardımcı olabilecek bir arkadaş var mı acaba ?

 

[Korhan Ayhan]

Merhaba,

HEDEF isimli sayfanıza veri aktarılırken her seferinde sayfadaki eski veriler temizlenip yeni veriler mi aktarılacak?

Kurgu nasıl olmalı? Detay vermelisiniz.

 

[dengeceteris]

Evet Korhan bey sayfanın eski verileri temizlenip yeni veriler aktarılacak. Kurgu tamamen benim HEDEF klasörümde ki gibi olacak. Bunu yaparken ki yazacağınız kodlama da benim için önemli çok profesyonel olmadığı müddetçe yorumlayıp uyarlayabiliyorum. Çünkü benzeri yapıda veya bazen farklı formatta ama buna yakın dosyalarım olabiliyor. (Yapı olarak bir kaç sütun eksik yada fazla gibi) Birde sizden ricam: Mesela VERİ kitabımın için de VERİ, VERİ1, VERİ2 gibi sayfalarım olabiliyor. Tabiki haliyle HEDEF kitabında da HEDEF, HEDEF1, HEDEF2 gibi sayfalarım oluyor. Yazacağınız kodu bu anlamda genişletebilirim umarım.

 

[Korhan Ayhan]

Deneyiniz.

Option Explicit

Sub Verileri_Aktar()
    Dim Dosya As String, Baglanti As Object, Sorgu As String
    Dim Kayit_Seti As Object, Zaman As Double
    
    Zaman = Timer
    
    Set Baglanti = CreateObject("AdoDb.Connection")
    
    Dosya = ThisWorkbook.Path & Application.PathSeparator & "VERİ.xlsm"
    
    Range("A2:F" & Rows.Count).ClearContents
    
    Baglanti.Open "Provider=Microsoft.Ace.OleDb.12.0;Data Source=" & _
    Dosya & ";Extended Properties=""Excel 12.0;Hdr=Yes"""
          
    Sorgu = "Select Month([Tarih]),[Tarih],Left([HesapKodu],3),[HesapAdı],[Borc],[Alacak] From [VERİ$]"
    
    Set Kayit_Seti = Baglanti.Execute(Sorgu)
    
    Range("A2").CopyFromRecordset Kayit_Seti
    
    Kayit_Seti.Close
    Baglanti.Close
    
    Set Kayit_Seti = Nothing
    Set Baglanti = Nothing
    
    MsgBox "Veri aktarımı tamamlanmıştır." & Chr(10) & Chr(10) & _
           "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye", vbInformation
End Sub

 

[dengeceteris]

Korhan bey muhteşemsin . Sadece ekstra bir sorum olacak. HEDEF dosyamda Hedef1, Hedef2, Hedef3, Hedef4, Hedef5 ve Hedef6 isimli sayfalarım olsa VERİ dosyamda ise Veri1, Veri2, Veri3, Veri4, Veri5 ve Veri6 sayfalarım olsa eş zamanlı olarak aşağıda gibi aktarma mümkün mü ? Ancak aktarma yaparken sadece mesela Veri sayfasında A sütununda ki kodların sadece 3 yada 5 (Tek seçim) karakter uzunluğunda olanları aktarsın.
127.01.902, 127.02.900, 127.01, 127 (mesela bu kod yapısında sadece 127 (3 karakter uzunluğunda olan gelsin) (Aslında Kapalı Dosyaya Veri Aktarma (Kurallı) isminde forum başlığınıda inceliyorum hemen hemen olayları anlıyorum ama şu dediğimi de yapabilirsek geliştirmek adına epeyce bir yol katedeceğim.

Veri1= Hedef1
Veri2= Hedef2
Veri3= Hedef3
Veri4= Hedef4
Veri5= Hedef5
Veri6= Hedef6

 

[Korhan Ayhan]

Aynı mantıkla örnek dosyalarınızı paylaşınız. Dosyalarınız üzerinden güncel kodu paylaşalım.

 

[dengeceteris]

HEDEF isimli çalışma sayfasına BUTONSAYFASI koydum o sayfada butona basınca dediğim gibi veriler ama sadece 3 karakter uzunluğu gelsin. (Renkli olanlar) HEDEF sayfalarında gerekli veriler mevcut

 

[Korhan Ayhan]

Deneyiniz.

Sorgu satırını dilerseniz aşağıdaki gibi değiştirebilirsiniz.

Sorgu = "Select * From [" & Kaynak_Sayfalar(X) & "$] Where Len([HesapKodu])=3"

Option Explicit

Sub Verileri_Aktar()
    Dim Dosya As String, Baglanti As Object, Sorgu As String
    Dim Kayit_Seti As Object, Sayfa As Worksheet, Zaman As Double
    Dim Hedef_Sayfalar As Variant, Kaynak_Sayfalar As Variant, X As Byte
   
    Zaman = Timer
   
    Set Baglanti = CreateObject("AdoDb.Connection")
   
    Dosya = ThisWorkbook.Path & Application.PathSeparator & "VERİ.xlsm"
   
    Baglanti.Open "Provider=Microsoft.Ace.OleDb.12.0;Data Source=" & _
    Dosya & ";Extended Properties=""Excel 12.0;Hdr=Yes"""
   
    Hedef_Sayfalar = Array("HEDEF1", "HEDEF2", "HEDEF3", "HEDEF4", "HEDEF5", "HEDEF6")
    Kaynak_Sayfalar = Array("VERİ1", "VERİ2", "VERİ3", "VERİ4", "VERİ5", "VERİ6")
   
    For X = 0 To UBound(Hedef_Sayfalar)
        Set Sayfa = Sheets(CStr(Hedef_Sayfalar(X)))
        Sayfa.Range("A2:H" & Rows.Count).ClearContents
             
        Sorgu = "Select [HesapKodu],[HesapAdı],[Tarih],[Fiş No],[Evrakno],[Açıklama],[Borc],[Alacak] From [" & Kaynak_Sayfalar(X) & "$] Where Len([HesapKodu])=3"
       
        Set Kayit_Seti = Baglanti.Execute(Sorgu)
       
        Sayfa.Range("A2").CopyFromRecordset Kayit_Seti
       
        Sayfa.Columns.AutoFit
    Next
   
    Kayit_Seti.Close
    Baglanti.Close
   
    Set Kayit_Seti = Nothing
    Set Baglanti = Nothing
   
    MsgBox "Veri aktarımı tamamlanmıştır." & Chr(10) & Chr(10) & _
           "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye", vbInformation
End Sub

 

[dengeceteris]

Korhan bey'im çok ama çok tşk ederim. )

 

[dengeceteris]

Korhan bey merhabalar: Yukarıda yazmış olduğunuz kod çok işimi görüyor sağolun. Sadece ek olarak iki husus sormak istiyorum.
1. Aşağıda yazan bölüm de diyelim ki A sütununda Hesap Kodu var B sütununu boş bırakıp Hesap adı başlığını C sütununa kaydırınca yani arada boş bir sütun bıraktım yada sütunlarım arasında bazen boş alanlar bırakıyorum. Bunu nasıl tanımlayabilirim.

Sorgu = "Select [HesapKodu],[HesapAdı],[Tarih],[Fiş No],[Evrakno],[Açıklama],[Borc],[Alacak] From [" & Kaynak_Sayfalar(X) & "$] Where Len([HesapKodu])=3"

2. Sayfalar arası transferlerde ilk sorumda ki başlıkları ilk satırda değilde mesela 3 veya 4. satıra konumlandırırsam kodun neresinde değişiklik yapmam gerekiyor.

 

[Korhan Ayhan]

Deneyiniz.

Sorgu = "Select [HesapKodu],Null,[HesapAdı],[Tarih],[Fiş No],[Evrakno],[Açıklama],[Borc],[Alacak] From [" & Kaynak_Sayfalar(X) & "$] Where Len([HesapKodu])=3"

2. sorunuz için varolan kodu deneyin bakalım sonuç üretecek mi?

 

[dengeceteris]

Korhan beyim on numara beş yıldız )