Çözüldü Kapalı Dosyadan Veri Alabilme Hakkında...

[yesimgurol]

Merhabalar,
Öncelikle şunu ifade etmek isterim ki, bu konuda forumda yapılan örnekleri inceledim ama alacağım veriler aralıklı olduğundan kendime göre uyarlayamadım :-(
Yapmaya çalıştığım işlem basamaklarını yazacak olur isem;
"Açık" isimli sayfaya, "kapalı" isimli sayfadan veri almak istiyorum.
"Kapalı" isimli sayfadaki "E4:E114" değerlerini , "Açık" isimli sayfadaki "D4114" kısmına ,
"Kapalı" isimli sayfadaki "H4:H114" değerlerini , "Açık" isimli sayfadaki "E4:E114" kısmına ,
"Kapalı" isimli sayfadaki "K4:K114" değerlerini , "Açık" isimli sayfadaki "F4:F114" kısmına ,
.
.
.
Bu şeklide devam etmekte veriler. Bu kadarı yapılabilir ise bende devamını getirebilirim diye düşünüyorum.
Yalnız "Kapalı" isimli dosyadaki verilerin bulunduğu kısım formüllü olacak, veriler aktarılır iken sorun olur mu bilemiyorum.

 

[yunusemre16]

Merhaba,

Daha kolayı vardır kesinlikle ama bu şekilde veri çekebilirsiniz. Daha sonra formülü E114e kadar indirebilirsiniz.

='[kapalı.xlsx]HAM VERİLER'!$E$4

 

[yesimgurol]

Merhaba,

Daha kolayı vardır kesinlikle ama bu şekilde veri çekebilirsiniz. Daha sonra formülü E114e kadar indirebilirsiniz.

='[kapalı.xlsx]HAM VERİLER'!$E$4

Yunus bey, ilginize teşekkür ederim. Yalnız verileri aktaracağım sayfada formül olmasını istemiyordum:-(

 

[yunusemre16]

Yunus bey, ilginize teşekkür ederim. Yalnız verileri aktaracağım sayfada formül olmasını istemiyordum:-(

O zaman işlem makrolara kalıyor sanırım. Bunun içinde üstadlar yardımcı olabilir size

 

[Zeki Gürsoy]

Aşağıdaki kodları "açık" isimli dosyada boş bir module yapıştırdıktan "getdata" isimli proseduru çalıştırın.

Public Sub GetData()
    f = ThisWorkbook.Path & "\kapalı.xlsx"
    s = "ham veriler"
    
    For i = 4 To 114
        Cells(i, "d") = Excel4(f, s, i, 5)
        Cells(i, "e") = Excel4(f, s, i, 8)
        Cells(i, "f") = Excel4(f, s, i, 11)
    Next
End Sub

Private Function Excel4(ByVal fileName As String, ByVal sheetName As String, _
                        ByVal rowIndex As Long, ByVal columnIndex As Long)
    Dim file As String
    file = Replace(fileName, Dir(fileName), "[" & Dir(fileName) & "]")
    Excel4 = ExecuteExcel4Macro("'" & file & sheetName & "'!R" & rowIndex & "C" & columnIndex)
End Function

 

[yesimgurol]

Zeki bey, çok ama çok teşekkür ederim. Diğer kısımlar içinde şimdi düzenlemeye çalışacağım umarım başarırım. Gerçekten çok teşekkür ederim. İstediğim gibi olmuş.

 

[yesimgurol]

Merhabalar ,
Zeki Bey'in konu çözümü için 5 nolu mesajında yer alan kodlar üzerinde küçük bir düzenlemeye ihtiyacım oluştu:-(
Şöyle ki;
Kodlar "açık" isimli sayfada gayet güzel çalışmaktadır. Lakin ben bu kodları başka bir sayfa üzerinde çalıştırdığımda aktif olan yani kodları çalıştırdığım sayfada ki hücrelere verileri aktarmakta. İlk mesajımda ben "açık" isimli sayfaya aktarılacak dediğim için haliyle o şekliyle Sağolsun Zeki bey o şekliyle düzenlemişti.
Mesela ,"güncelle" sayfası diye bir sayfa açsam ve bu kodları çalıştırsam ,değerleri "açık" isimli sayfaya kodlardaki şekliyle aktarması için düzenleme yapılabilir mi?

 

[Korhan Ayhan]

Cells ibarelerinin başına sayfa ismini eklemeniz yeterli olacaktır.

Sheets ("açık").Cells(i, "d") = Excel4(f, s, i, 5) (

 

[yesimgurol]

Korhan Bey,çok teşekkür ederim ilginize..

 

[yesimgurol]

Kusuruma bakmaz iseniz son bir ricam olsa

Kodlar aslında tamda istediğim çalışıyor,sorunsuz..Lakin kodları çalıştırdığımda çok uzun sürüyor:-( daha hızlı olabilmesi adına bir düzenleme yapılabilir mi?
Forumda örnek dosyaları incelerken benim soruma yakın bir konuda Sayın Orion tarafından yapılmış bir kod buldum.

Sub verial_ado()
Dim con As Object, rs As Object
Set con = CreateObject("Adodb.connection")
Set rs = CreateObject("Adodb.recordset")
con.Open "Provider=microsoft.ace.oledb.12.0;data source=" & ThisWorkbook.Path & _
        "\Kapalı Dosya.xlsx;extended properties=""excel 12.0;hdr=yes"""
rs.Open "select * from[Sheet1$] where [Gönderilen BÖLGE]='" & Range("B1").Value & "';", con, 1, 3
Application.ScreenUpdating = False
Range("A4").CopyFromRecordset rs
Application.ScreenUpdating = True
rs.Close: con.Close
Set rs = Nothing: Set con = Nothing
MsgBox "Veriler alındı."
End Sub

Tamda detayı bilemiyorum ama örnek dosya üzerinden baktığımda sanki daha hızlı bir şekilde veriler geliyor gibi geldi bana

 

[Korhan Ayhan]

ADO çözümleri ExecuteExcel4Macro kodlarına göre kat kat hızlı sonuç vermektedir.

 

[yesimgurol]

Korhan bey,Zeki bey'in 5nolu mesajındaki kodları

ADO çözümleri ExecuteExcel4Macro kodlarına göre kat kat hızlı sonuç vermektedir.

ADO çözümleri ile revize edilmesi mümkün olur mu acaba

 

[Korhan Ayhan]

Deneyiniz.

Dosya ve sayfa isimlerindeki büyük-küçük harf durumuna dikkat edersiniz.

Option Explicit

Sub Aktar()
    Dim Baglanti As Object, Kayit_Seti As Object
    Dim Alan_A As Variant, Alan_B As Variant, X As Integer
    
    Application.ScreenUpdating = False
    
    Set Baglanti = CreateObject("AdoDb.Connection")
    
    Baglanti.Open "Provider=Microsoft.Ace.OleDb.12.0;Data Source=" & _
    ThisWorkbook.Path & "\kapalı.xlsx" & ";Extended Properties=""Excel 12.0;Hdr=No"""
    
    Alan_A = Array("E4:E114", "H4:H114", "K4:K114")
    Alan_B = Array("D4", "E4", "F4")
    
    For X = 0 To UBound(Alan_A)
        Set Kayit_Seti = Baglanti.Execute("Select * From [HAM VERİLER$" & Alan_A(X) & "]")
        Range(Alan_B(X)).CopyFromRecordset Kayit_Seti
    Next
    
    Kayit_Seti.Close
    Baglanti.Close
    
    Set Kayit_Seti = Nothing
    Set Baglanti = Nothing
    
    Application.ScreenUpdating = True
    
    MsgBox "Veri aktarımı tamamlanmıştır.", vbInformation
End Sub