• DİKKAT

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

  • Forum yazılımı güncelenmiştir.

    Beklenmedik durumlar görürseniz lütfen yönetime iletin.

Klasör ve alt klasörlerden isme bağlı olarak aynı hücredeki veriye çekmek listelemek

N

nongeyikm

Katılım
7 Kasım 2005
Mesajlar
505
Excel Vers. ve Dili
Office 365 TR-64
klasör ve alt klasörlerden dosya isimlerine bağlı olarak belirli hücrelerdeki veriye çekmek bir bir sayfada özet şeklinde listelemek istiyorum. Her kişiye ait bir dosya var ve tüm kişilere ait dosyaların hücre ve tablo yapıları aynı.

Asıl istediğim şey ise, hangi hücreleri seçeceğimi listelenecek sayfada hücre adı ile benim belirlemiş olmam. Bu belirlenecek hücreler tüm çalışma sayfaları için geçerli.

örneğin :
tüm dosyalardan;
A2
B5
C8
T13
T17
VS.... tercih edeceğim hücreleri dosya ismini de a4 hücresine yazarak sağa doğru verileri çekmeli. Veri çekeceğim dosya sayısı yaklaşık 200 adet ve her dosyadan çekeceğim hücre verisi 50 civarında.

Saygılar,
 
Dosyalarınızın hepsi aynı klasörde olsun.

Sonra kodu çalıştırın.

C++: 
Option Explicit

Sub ADO_Verileri_Aktar()
    Dim Yol As String, Dosya As Variant, Zaman As Double
    Dim Baglanti As Object, S1 As Worksheet, Sorgu As String
    Dim Kayit_Seti As Object, Sayfa As String
    Dim Hucre_Adresi As Variant, Adres As Variant
    Dim Satir As Long, Sutun As Byte
      
    Zaman = Timer
  
    Application.ScreenUpdating = False
  
    Set Baglanti = CreateObject("AdoDb.Connection")
    Set Kayit_Seti = CreateObject("AdoDb.Recordset")
    Set S1 = Sheets("Sayfa1")
      
    S1.Range("A4:L" & S1.Rows.Count).Clear
    Satir = 4
    
    Yol = ThisWorkbook.Path & Application.PathSeparator
    
    Dosya = Dir(Yol & "*.xls*")
    
    Hucre_Adresi = Array("G3:O3", "G4:O4", "G5:O5", "G6:O6", "G7:O7", "G8:O8", "G9:O9", "G10:O10", "G11:O11", "M30:P30", "M31:P31", "M32:P32")
    
    While Dosya <> ""
        If Dosya <> ThisWorkbook.Name Then
            Baglanti.Open "Provider=Microsoft.Ace.OleDb.12.0;Data Source=" & _
            Yol & Dosya & ";Extended Properties=""Excel 12.0;Hdr=No"""
        
            Sayfa = Replace(CreateObject("Scripting.FileSystemObject").GetBaseName(Dosya), "Personel Tanıtım Formu_", "")
        
            For Each Adres In Hucre_Adresi
                Sorgu = "Select * From [" & Sayfa & "$" & Adres & "]"
                Kayit_Seti.Open Sorgu, Baglanti, 1, 1
                Sutun = Sutun + 1
                S1.Cells(Satir, Sutun).CopyFromRecordset Kayit_Seti
                If Kayit_Seti.State <> 0 Then Kayit_Seti.Close
            Next
            
            Satir = Satir + 1
            Sutun = 0
        End If
        If Baglanti.State <> 0 Then Baglanti.Close
        Dosya = Dir
    Wend
    
    S1.Range("H4:I" & Satir - 1).NumberFormat = "dd.mm.yyyy"
    S1.Range("J4:L" & Satir - 1).NumberFormat = "#,##0.00"
    S1.Columns.AutoFit
    
    Set Kayit_Seti = Nothing
    Set Baglanti = Nothing
    Set S1 = Nothing
          
    Application.ScreenUpdating = True
          
    MsgBox "Veri aktarımı tamamlanmıştır." & Chr(10) & Chr(10) & _
           "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye", vbInformation
End Sub
 
Korhan Bey çok teşekkür ederim.
 
Son düzenleme:
Korhan Bey çok teşekkürler. Aynı mantık bana da lazım ancak veri çekilecek dosya isimleri standart değil bu kısmını revize edebilir miyiz. Hücre adreslerini yazdığınız kısımda birleştirilmiş hücre yerine tek bir hücre varsa sadece hücre ismini yazmamız yeterli mi acaba.Adsız.png Ayrıca bende bu şekilde bir hata veriyor sebebini anlayamadım.Adsız.png
 

Ekli dosyalar

  • Adsız22.png
    Adsız22.png
    120.2 KB · Görüntüleme: 6
Son düzenleme:
Korhan Bey,

M hücrelerindeki değerler (sayı) tarih formatında geliyor. hücre biçimini sayı yapmama rağmen tekrar veri çekince yine tarih formatına dönüyor. Bakabilirmisiniz?
 
dosya isimleri ile dosyada yer alan isimleri kontrol ediniz. sicillere de bakınız.
 
@tukayf,

Kodun sağlıklı çalışması için dosya isimi ile içindeki sayfa adının aynı olması gerekiyor.

Personel Tanıtım Formu_AHMET MERT.xlsx

Tek hücre için adres bölümünü G3:G3 olarak yazabilirsiniz.
 
Korhan Ayhan' Alıntı:
@tukayf,

Kodun sağlıklı çalışması için dosya isimi ile içindeki sayfa adının aynı olması gerekiyor.

Personel Tanıtım Formu_AHMET MERT.xlsx

Tek hücre için adres bölümünü G3:G3 olarak yazabilirsiniz.
Genişletmek için tıkla ...
Sn. Hocam peki bendeki sayfa adlarının hemen hemen hepsi Sayfa1 şeklinde bu şekilde dönüştürebilir miyiz acaba.
 
Sorgu satırını aşağıdaki gibi düzenleyip kullanabilirsiniz.

Sorgu = "Select * From [Sayfa1" & "$" & Adres & "]"
 
Sayfa = Replace(CreateObject("Scripting.FileSystemObject").GetBaseName(Dosya), "Personel Tanıtım Formu_", "")

Hocam burda nasıl bir değişiklik yapmalıyım dosya adalarının bir standardı yok.
 
O satırı silebilirsiniz. Bu satırla sayfa adını alıyorduk. Sizdeki sayfa isimleri Sayfa1 olduğu için bu satıra gerek kalmamış oldu.
 
Hocam çok teşekkürler. Zihninize sağlık.
 
Korhan Bey,

M hücrelerindeki değerler (sayı) tarih formatında geliyor. hücre biçimini sayı yapmama rağmen tekrar veri çekince yine tarih formatına dönüyor. Bakabilirmisiniz?
 
Sayı biçimini makro kaydet ile elde ettikten sonra oluşan kodu benim verdiğim koda entegre edip kullanabilirsiniz. Hem bu şekilde makrolara adım atmış olursunuz.

Uyarlama yapamam derseniz belirtin destek olalım.
 
Kendinizin çözmesine sevindim.

Ben de #3 nolu mesajımda ki koda hücreleri biçimlendiren kod satırlarını ekledim.
 
Korhan Ayhan' Alıntı:
Sorgu satırını aşağıdaki gibi düzenleyip kullanabilirsiniz.

Sorgu = "Select * From [Sayfa1" & "$" & Adres & "]"
Genişletmek için tıkla ...

Sayfa adının önemi olmadan verileri nasıl çekebiliriz hocam. Activesheet denedim yapamadım. Ordaki kodu nasıl değiştirmeliyim.
 
Bunun için önce kapalı dosyadaki sayfa adını öğrenmek gerekiyor. Eğer kapalı dosyada birden fazla sayfa varsa hangisinden veri alınacağını bilmeniz gerekiyor.

Aşağıdaki linkteki mesajda buna ilişkin kodlama var. Kendinize uyarlayabilirsiniz. (Anahtar kelime; Catalog)

Kapalı Dosyadan Veri Çekme

Deneyin bakalım olmuş mu? Yapı itibari ile olmuş elinize sağlık. Tek kusuru Aylık ebat dönüşü sheetinde bakiye tonaj sütununa boyları toplayıp getiriyor. Bakiye tonajı toplayıp getirmesi için küçük bir dokunuşunuza ihtiyaç var sanırım. :)
www.excel.web.tr www.excel.web.tr
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst