Çözüldü VBA ile kapalı dosyadan veri almak

[adige92]

merhaba,

yaklaşık 600.000 satırlık excel dosyam var. buradan düşeyara ile istediğim verileri almak istiyorum. Veri dosyam sürekli kapalı olacak, aylık yeni veriler girmem gerekecek. Ana dosyamla veri dosyam farklı klasörde olacaklar.

Düşey ara dışında farklı yöntem kullanabilirmiyim yada excel dışında access hangi yöntem daha doğru ve hızlı sonuç almamamı sağlar.

yardımlarınızı rica ederim.

Desktop.rar dosyasını indir - download

Desktop.rar dosyasını indir, download. Dosya.tc .Dosya Upload. Dosya Paylaş. Dosya Yükle

s7.dosya.tc

 

[Haluk]

Excel versiyonunuz halen 2007 ise, ADO dışında fazla bir alternatifiniz yok.

Daha ileri bir versiyonunuz varsa, gerçi ben kullanmıyorum ama Power Query olabilir. Ama her şartta, veri tabanı dosyanız şu anda bile 60 MB civarında. Eğer biraz daha yeni bir versiyonunuz varsa, örneğin 2010 gibi.... dosyayı XLSB formatında kaydederseniz dosya büyüklüğü 17 MB'a düşüyor. En azından açıp, kapatması rahatlar. ADO veya başka bir yöntem kullanırken de rahatlama sağlar.

.

 

[adige92]

merhaba,

Excel 2016 kullanıyorum. dosyaları sistemden indiridiğimden 2007 olarak gözükmektedir.

 

[Korhan Ayhan]

Öncelikle sonuçları görmek istediğiniz alandaki birleştirilmiş hücreleri çözünüz.

Sonra iki dosya açıkken aşağıdaki DİZİ formülleri uygulayınız.

B19;

=İNDİS([VERİ.xlsx]Sayfa1!$A:$V;KAÇINCI(E14&F14&B14&C14;[VERİ.xlsx]Sayfa1!$A:$A&[VERİ.xlsx]Sayfa1!$D:$D&[VERİ.xlsx]Sayfa1!$E:$E;0);2)

C19;

=İNDİS([VERİ.xlsx]Sayfa1!$A:$V;KAÇINCI(E14&F14&B14&C14;[VERİ.xlsx]Sayfa1!$A:$A&[VERİ.xlsx]Sayfa1!$D:$D&[VERİ.xlsx]Sayfa1!$E:$E;0);3)

D19;

=İNDİS([VERİ.xlsx]Sayfa1!$A:$V;KAÇINCI(E14&F14&B14&C14;[VERİ.xlsx]Sayfa1!$A:$A&[VERİ.xlsx]Sayfa1!$D:$D&[VERİ.xlsx]Sayfa1!$E:$E;0);KAÇINCI(D14;[VERİ.xlsx]Sayfa1!$A$1:$V$1;0))

Sonrasında VERİ isimli dosyanızı kapatabilirsiniz.

Son olarak arama kriterlerinizi değiştirip sonuçlar gözlemleyiniz.

 

[adige92]

Korhan bey,

Vermiş olduğunuz formülleri iki sayfamda açıkken uyguladım ancak #değer hatası almaktayım. Dosyayı kapatıp çalıştırdığımda ise Ana Sayfa'da formülü çalıştırmak istediğimde sayfa uzun süre cevap vermemektedir.

Formül dışında makro kullanabilir miyim? makro nasıl olmalı? desteğinizi rica ederim.

 

[Korhan Ayhan]

Deneyiniz.

İki dosyanızda aynı klasörde olsun.

Arama kriterlerinizin tümünü girdikten sonra butona tıkladığınızda sonuç gelecektir.

 

[adige92]

korhan hocam,

teşekkür ederim. çok güzel çalışıyor.

sadece sormak istediğim iki şey var.

1) İki dosya aynı klasörede olmayacak veri dosyam C:\VERİ klasörü içerisinde yer alacak buna göre revize edebilirmiyiz
2) sonuç bazen 20-25sn bazen 40-45 sn gelmektedir. Daha hızlı olması ve çalışma sayfamda donma oluşmamasısı için alternatif çözüm öneriniz varmıdır.

 

[Korhan Ayhan]

Hedef dosya yolunu aşağıdaki satırı kullanarak değiştirebilirsiniz.

My_File = ThisWorkbook.Path & Application.PathSeparator & "[VERİ.xlsx]"

Mesela aşağıdaki gibi olabilir. Kendi sisteminıze göre revize edersiniz.

My_File = "C:\Belgelerim\[VERİ.xlsx]"

ADO en hızlı yöntemlerden birisidir. Dosyanın kapalı olma durumundan dolayı zaten fazla bir seçeneğiniz yok.

Belki hedef dosyayı TXT olarak düzenleyebilirseniz hız olarak avantaj sağlayabilir.

Ya da verilerinizi Access üzerinde tutup excel üzerinden sorgulayabilirsiniz. Daha verimli sonuçlar alabilirsiniz. Forumda bununla ilgili örneklerin olması gerekiyor. Arama yaparsanız ulaşabilirsiniz.

 

[adige92]

Teşekkür ederim. Ellerinize sağlık

 

[adige92]

Merhaba,

Daha önceki hazırlamış olduğunuz dosya bizlere çok yardımcı oldu, ancak geçen süre içerisinde yeni veriler eklenince dosya boyutu ve veri sayısı arttığı için hata vermeye ve veri getirme işlemi çok daha uzun zaman almaya başladı.
Ekte sunduğum yeni dosya yapısına göre verileri yine makro ile nasıl getirilebilir konusunda destek bekliyorum.

Dosya ektedir.

https://s7.dosya.tc/server25/i3vfqo/Desktop.rar.html

 

[Korhan Ayhan]

Paylaştığınız dosyada MODEL yılını yazdığınızda hangi klasörde arama yapılacak?

 

[adige92]

Kaza Yıl ve Ay' ına göre klasörler sıralanmıştır.
Ilgili kaza tarihindeki dosyada model yılına denk gelen bilgileri getirmesi istenmektedir.

 

[Korhan Ayhan]

Klasördeki dosyalarda sayfa isimleri standart mı?

 

[adige92]

Evet tüm dosya isimleri ve sayfa isimleri standart

 

[Korhan Ayhan]

Sayfa isimleri nedir?

 

[adige92]

Smarka

 

[Korhan Ayhan]

Lokal bilgisayarda sonuç alıyorum. Umarım sizde de çalışır.

Klasördeki dosyalarınızın uzantılarına dikkat etmelisiniz. Hepsi aynı formatta olursa sorun yaşamazsınız. (XLS)

Option Explicit

Sub Import_Data()
    Dim My_Connection As Object, My_Recordset As Object
    Dim File_Path As String, My_File As String, Process_Time As Double
    Dim My_Query As String, Year_Column As String
    Dim My_Extension As Variant, File_Checked As Boolean
 
    Process_Time = Timer
  
    Range("D4,D7,D10,D13").ClearContents
    
    File_Path = "\\server\DATA 3\List" & Application.PathSeparator & _
                Year(Range("B10").Value) & Application.PathSeparator
 
    For Each My_Extension In Array("xls", "xlsx", "xlsb", "xlsm")
        My_File = File_Path & "[" & Month(Range("B10").Value) & _
                  UCase(Replace(Replace(Format(Range("B10").Value, "-mmmm"), "ı", "I"), "i", "İ")) & "*." & My_Extension & "]"
        My_File = Dir(Replace(Replace(My_File, "[", ""), "]", ""))
        If My_File <> "" Then
            My_File = File_Path & "[" & My_File & "]"
            File_Checked = True
            Exit For
        End If
    Next
  
    If File_Checked = True Then
        Range("K1").FormulaArray = "=IFERROR(MATCH(CLEAN(B7),CLEAN('" & My_File & "Smarka'!$A$2:$V$2),0),"""")"
        Year_Column = "F" & Range("K1").Value
        Range("K1").ClearContents
            
        If Year_Column = "F" Then
            MsgBox "Model yılını kontrol ediniz!", vbCritical
            Exit Sub
        End If
    
        Set My_Connection = VBA.CreateObject("AdoDb.Connection")
        Set My_Recordset = VBA.CreateObject("AdoDb.Recordset")
    
        My_Connection.Open "Provider=Microsoft.Ace.OleDb.12.0;Data Source=" & _
        Replace(Replace(My_File, "]", ""), "[", "") & ";Extended Properties=""Excel 12.0;Hdr=No"""
        
        My_Query = "Select F3,F1,F2," & Year_Column & " From [Smarka$] Where F4 = '" & Trim(Range("B4")) & "'"
       
        My_Recordset.Open My_Query, My_Connection, 1, 1
       
        If My_Recordset.RecordCount > 0 Then
            Range("D4") = My_Recordset("F3").Value
            Range("D7") = My_Recordset("F1").Value
            Range("D10") = My_Recordset("F2").Value
            Range("D13") = My_Recordset(Year_Column).Value
            Columns.AutoFit
            MsgBox "Veri aktarımı tamamlanmıştır." & vbCrLf & vbCrLf & _
                   "İşlem süresi ; " & Format(Timer - Process_Time, "0.00") & " Saniye"
        Else
            MsgBox "Aradığınız kriterlere uygun kayıt bulunamadı!", vbExclamation
        End If
       
        If My_Recordset.State <> 0 Then My_Recordset.Close
        If My_Connection.State <> 0 Then My_Connection.Close
     
        Set My_Connection = Nothing
        Set My_Recordset = Nothing
    Else
        MsgBox "Dosya bulunamadı!", vbExclamation
    End If
End Sub

 

[adige92]

merhaba,

hocam Ocak 2022 için veri getirmekte ancak yılı ve ayı değiştirdiğimde ekteki hatayı almaktayım.

 

[Korhan Ayhan]

Sorunlu hedef dosyayı paylaşırsanız deneme şansım olabilir.

 

[adige92]

Hocam dosyalar ektedir.

List.rar dosyasını indir - download

List.rar dosyasını indir, download. Dosya.tc .Dosya Upload. Dosya Paylaş. Dosya Yükle

s7.dosya.tc