Kapalı Dosyadan Veri Çekme

Korhan Ayhan · 25 Haziran 2020

Tek bir dosyadan mı veri alınacak?

TheNomAd · 25 Haziran 2020

Korhan Ayhan' Alıntı:
Tek bir dosyadan mı veri alınacak?

Evet Korhan bey. Data isimli yada ismi daha farklı olan bir dosyadan veri alınacak, isim değişken olacak yani.

Saygılarımla

Korhan Ayhan · 25 Haziran 2020

Peki dosyanın içindeki sayfa adı sabit mi?

TheNomAd · 25 Haziran 2020

Korhan Ayhan' Alıntı:
Peki dosyanın içindeki sayfa adı sabit mi?

Dosya içindeki adı sheet1 yada sayfa1 olacaktır Office diline göre, yani sanırım o da değişken oluyor.

Korhan Ayhan · 26 Haziran 2020

Deneyiniz.

TheNomAd · 26 Haziran 2020

Korhan Ayhan' Alıntı:
Deneyiniz.

Korhan bey öncelikle emeğiniz için çok teşekkür ederim. İki adet ricam olacak. Birincisi "Rapor" dan "Aylık Ebat dönüş" diye değiştirdiğim sheet'de Text yada sayı olarak gelmesi gereken veriler tarih olarak geliyor bunu nasıl düzeltebilirim? İkincisi yine bu Aylık ebat dönüş sheet'ine veri eklemek istediğimde nereye müdahale etmeliyim? Yardımlarınızı rica ederim.

TheNomAd · 26 Haziran 2020

TheNomAd' Alıntı:
Korhan bey öncelikle emeğiniz için çok teşekkür ederim. İki adet ricam olacak. Birincisi "Rapor" dan "Aylık Ebat dönüş" diye değiştirdiğim sheet'de Text yada sayı olarak gelmesi gereken veriler tarih olarak geliyor bunu nasıl düzeltebilirim? İkincisi yine bu Aylık ebat dönüş sheet'ine veri eklemek istediğimde nereye müdahale etmeliyim? Yardımlarınızı rica ederim.

Ayrıca Aylık ebat dönüşü sheet'inden Alt toplam değerlerini de çıkarabilir miyiz acaba?

Korhan Ayhan · 26 Haziran 2020

Merhaba,

Makro yazmayı bilmiyorsanız müdahale etmeniz zor olur.

Yine de paylaşayım.

Dizi bölümüne müdahale etmeniz gerekiyor. Aşağıdaki satırları değiştirmelisiniz.

ReDim Liste(1 To UBound(Veri), 1 To 4)
Liste(Say, 4) = Veri(X, 8)

Dilerseniz raporlama kısmında olması gereken bölümlerin son hali ile dosyanızı paylaşın kodu ona göre revize edelim.

Yok eğer ben kendim yapmak istiyorum derseniz bu rapor yerine Pivot Table (Özet Tablo) kullanın. Sizin açınızdan daha kullanışlı olabilir.

TheNomAd · 26 Haziran 2020

Korhan Ayhan' Alıntı:
Merhaba,

Makro yazmayı bilmiyorsanız müdahale etmeniz zor olur.

Yine de paylaşayım.

Dizi bölümüne müdahale etmeniz gerekiyor. Aşağıdaki satırları değiştirmelisiniz.

ReDim Liste(1 To UBound(Veri), 1 To 4)
Liste(Say, 4) = Veri(X, 8)

Dilerseniz raporlama kısmında olması gereken bölümlerin son hali ile dosyanızı paylaşın kodu ona göre revize edelim.

Yok eğer ben kendim yapmak istiyorum derseniz bu rapor yerine Pivot Table (Özet Tablo) kullanın. Sizin açınızdan daha kullanışlı olabilir.

Bu iki konu ile ilgili yorumunuz nedir peki?
1- "Rapor" dan "Aylık Ebat dönüş" diye değiştirdiğim sheet'de Text yada sayı olarak gelmesi gereken veriler tarih olarak geliyor bunu nasıl düzeltebilirim?
2- Aylık ebat dönüşü sheet'inden Alt toplam değerlerini de çıkarabilir miyiz acaba?

Korhan Ayhan · 26 Haziran 2020

1-2 nolu sorunlar için aşağıdaki kodu deneyiniz. Bakalım sorun düzelecek mi?

C++:

Option Explicit

Sub Verileri_Aktar()
    Dim Dosya As Variant, Zaman As Double, Baglanti As Object, S1 As Worksheet
    Dim Tum_Tablolar As Object, Sayfa As Object, Dizi As Object, S2 As Worksheet
    Dim Sayfa_Adi As String, Sorgu As String, Kayit_Seti As Object
    Dim Son As Long, Veri As Variant, X As Long, Aranan As String, Say As Long
  
    Dosya = Application.GetOpenFilename(FileFilter:="Excel Çalışma Kitapları (*.xl*),*.xl*", _
            Title:="Lütfen Dosya Seçiniz", MultiSelect:=False)

    Zaman = Timer
  
    If Dosya <> False Then
        Set Baglanti = CreateObject("AdoDb.Connection")
        Set Tum_Tablolar = CreateObject("AdoX.Catalog")
        Set Sayfa = CreateObject("AdoX.Table")
        Set Dizi = CreateObject("Scripting.Dictionary")
        Set S1 = Sheets("Düzenlenmiş Data")
        Set S2 = Sheets("Aylık Ebat Dönüş")
      
        S1.Range("A2:L" & S1.Rows.Count).Clear
        S2.Range("A2:D" & S1.Rows.Count).Clear
  
        If Dosya <> ThisWorkbook.FullName Then
            Baglanti.Open "Provider=Microsoft.Ace.OleDb.12.0;Data Source=" & _
            Dosya & ";Extended Properties=""Excel 12.0;Hdr=No"""
          
            Tum_Tablolar.ActiveConnection = Baglanti
         
            For Each Sayfa In Tum_Tablolar.Tables
                If Replace(Sayfa.Name, "'", "") Like "*$" And InStr(1, Sayfa.Name, "Print_Area") = 0 Then
                    Sayfa_Adi = Sayfa.Name
                    Exit For
                End If
            Next
          
            Sorgu = "Select F29,F4,F7,F8,F1,F2,F9,F14,F15,F10,F22,F23 From [" & Sayfa_Adi & "A2:CA]"
            Set Kayit_Seti = Baglanti.Execute(Sorgu)
            S1.Cells(S1.Rows.Count, 1).End(3)(2, 1).CopyFromRecordset Kayit_Seti
            S1.Range("A2:B" & S1.Rows.Count).NumberFormat = "dd.mm.yyyy"
            S1.Columns.AutoFit
          
            If Kayit_Seti.State <> 0 Then Kayit_Seti.Close
            If Baglanti.State <> 0 Then Baglanti.Close
        End If
  
        Son = S1.Cells(S1.Rows.Count, 1).End(3).Row
      
        If Son = 1 Then
            MsgBox "Veri bulunamadı!", vbCritical
            GoTo 10
        ElseIf Son >= 2 Then
            If Son = 2 Then Son = 3
            Veri = S1.Range("A2:I" & Son).Value
          
            ReDim Liste(1 To UBound(Veri), 1 To 4)
          
            For X = LBound(Veri) To UBound(Veri)
                Aranan = Veri(X, 1) & "|" & Veri(X, 3)
                If Not Dizi.Exists(Aranan) Then
                    Say = Say + 1
                    Dizi.Add Aranan, Say
                    Liste(Say, 1) = Format(Veri(X, 1), "mmmm")
                    Liste(Say, 2) = Veri(X, 3)
                    Liste(Say, 3) = 1
                    Liste(Say, 4) = Veri(X, 8)
                Else
                    Liste(Dizi.Item(Aranan), 3) = Liste(Dizi.Item(Aranan), 3) + 1
                    Liste(Dizi.Item(Aranan), 4) = Liste(Dizi.Item(Aranan), 4) + Veri(X, 8)
                End If
            Next
      
            If Say > 0 Then
                S2.Range("A2").Resize(Say, UBound(Liste, 2)) = Liste
                S2.Range("A2:D" & S2.Rows.Count).Sort Key1:=S2.Range("A2"), Order1:=xlAscending, OrderCustom:=5
                S2.Range("B2:B" & S2.Rows.Count).NumberFormat = "General"
                S2.Columns.AutoFit
                S2.Select
            End If
          
            MsgBox "Veri aktarımı tamamlanmıştır." & Chr(10) & Chr(10) & _
                   "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye", vbInformation
        End If
  
10
        Set Kayit_Seti = Nothing
        Set Baglanti = Nothing
        Set Tum_Tablolar = Nothing
        Set Sayfa = Nothing
        Set Dizi = Nothing
        Set S1 = Nothing
        Set S2 = Nothing
    Else
        MsgBox "Dosya seçimi yapmadığınız için işleminiz iptal edilmiştir.", vbCritical
    End If
End Sub

TheNomAd · 26 Haziran 2020

Korhan Ayhan' Alıntı:

1-2 nolu sorunlar için aşağıdaki kodu deneyiniz. Bakalım sorun düzelecek mi?

C++:

Option Explicit

Sub Verileri_Aktar()
    Dim Dosya As Variant, Zaman As Double, Baglanti As Object, S1 As Worksheet
    Dim Tum_Tablolar As Object, Sayfa As Object, Dizi As Object, S2 As Worksheet
    Dim Sayfa_Adi As String, Sorgu As String, Kayit_Seti As Object
    Dim Son As Long, Veri As Variant, X As Long, Aranan As String, Say As Long
 
    Dosya = Application.GetOpenFilename(FileFilter:="Excel Çalışma Kitapları (*.xl*),*.xl*", _
            Title:="Lütfen Dosya Seçiniz", MultiSelect:=False)

    Zaman = Timer
 
    If Dosya <> False Then
        Set Baglanti = CreateObject("AdoDb.Connection")
        Set Tum_Tablolar = CreateObject("AdoX.Catalog")
        Set Sayfa = CreateObject("AdoX.Table")
        Set Dizi = CreateObject("Scripting.Dictionary")
        Set S1 = Sheets("Düzenlenmiş Data")
        Set S2 = Sheets("Aylık Ebat Dönüş")
     
        S1.Range("A2:L" & S1.Rows.Count).Clear
        S2.Range("A2:D" & S1.Rows.Count).Clear
 
        If Dosya <> ThisWorkbook.FullName Then
            Baglanti.Open "Provider=Microsoft.Ace.OleDb.12.0;Data Source=" & _
            Dosya & ";Extended Properties=""Excel 12.0;Hdr=No"""
         
            Tum_Tablolar.ActiveConnection = Baglanti
        
            For Each Sayfa In Tum_Tablolar.Tables
                If Replace(Sayfa.Name, "'", "") Like "*$" And InStr(1, Sayfa.Name, "Print_Area") = 0 Then
                    Sayfa_Adi = Sayfa.Name
                    Exit For
                End If
            Next
         
            Sorgu = "Select F29,F4,F7,F8,F1,F2,F9,F14,F15,F10,F22,F23 From [" & Sayfa_Adi & "A2:CA]"
            Set Kayit_Seti = Baglanti.Execute(Sorgu)
            S1.Cells(S1.Rows.Count, 1).End(3)(2, 1).CopyFromRecordset Kayit_Seti
            S1.Range("A2:B" & S1.Rows.Count).NumberFormat = "dd.mm.yyyy"
            S1.Columns.AutoFit
         
            If Kayit_Seti.State <> 0 Then Kayit_Seti.Close
            If Baglanti.State <> 0 Then Baglanti.Close
        End If
 
        Son = S1.Cells(S1.Rows.Count, 1).End(3).Row
     
        If Son = 1 Then
            MsgBox "Veri bulunamadı!", vbCritical
            GoTo 10
        ElseIf Son >= 2 Then
            If Son = 2 Then Son = 3
            Veri = S1.Range("A2:I" & Son).Value
         
            ReDim Liste(1 To UBound(Veri), 1 To 4)
         
            For X = LBound(Veri) To UBound(Veri)
                Aranan = Veri(X, 1) & "|" & Veri(X, 3)
                If Not Dizi.Exists(Aranan) Then
                    Say = Say + 1
                    Dizi.Add Aranan, Say
                    Liste(Say, 1) = Format(Veri(X, 1), "mmmm")
                    Liste(Say, 2) = Veri(X, 3)
                    Liste(Say, 3) = 1
                    Liste(Say, 4) = Veri(X, 8)
                Else
                    Liste(Dizi.Item(Aranan), 3) = Liste(Dizi.Item(Aranan), 3) + 1
                    Liste(Dizi.Item(Aranan), 4) = Liste(Dizi.Item(Aranan), 4) + Veri(X, 8)
                End If
            Next
     
            If Say > 0 Then
                S2.Range("A2").Resize(Say, UBound(Liste, 2)) = Liste
                S2.Range("A2:D" & S2.Rows.Count).Sort Key1:=S2.Range("A2"), Order1:=xlAscending, OrderCustom:=5
                S2.Range("B2:B" & S2.Rows.Count).NumberFormat = "General"
                S2.Columns.AutoFit
                S2.Select
            End If
         
            MsgBox "Veri aktarımı tamamlanmıştır." & Chr(10) & Chr(10) & _
                   "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye", vbInformation
        End If
 
10
        Set Kayit_Seti = Nothing
        Set Baglanti = Nothing
        Set Tum_Tablolar = Nothing
        Set Sayfa = Nothing
        Set Dizi = Nothing
        Set S1 = Nothing
        Set S2 = Nothing
    Else
        MsgBox "Dosya seçimi yapmadığınız için işleminiz iptal edilmiştir.", vbCritical
    End If
End Sub

Korhan bey
Tarih yerine Sayı gelme sorunu çözüldü fakat Ay yerine çapa göre sort yaptı kodlama. Bunu da düzeltmekte yardımcı olabilirseniz çok sevinirim.

TheNomAd · 26 Haziran 2020

TheNomAd' Alıntı:
Korhan bey
Tarih yerine Sayı gelme sorunu çözüldü fakat Ay yerine çapa göre sort yaptı kodlama. Bunu da düzeltmekte yardımcı olabilirseniz çok sevinirim.

Korhan Ayhan · 26 Haziran 2020

Bende söylediğiniz şekilde bir durum oluşmadı. Düzgün şekilde sıralama oluyor.

TheNomAd · 26 Haziran 2020

Korhan Ayhan' Alıntı:
Bende söylediğiniz şekilde bir durum oluşmadı. Düzgün şekilde sıralama oluyor.

Yazdığınız kodları tekrar tekrar silip yapıştırdım ama yine aynı sorun ile karşılaştım. Nerede yanlış yaptığımı inceleyebilmeniz için sizden aldığım kodların eklenmiş halindeki çalışma dosyasını paylaşıyorum. Yardımlarınızı rica ederim.

Korhan Ayhan · 26 Haziran 2020

Sayfadaki gruplandırmayı kaldırıp kodları çalıştırdığımda bende ekteki sonuç çıkıyor. Sanırım sizde sıralama kodlarındaki 5 parametresi sorun yaratıyor.

Bende SIRALA menüsü aşağıdaki görüntüdeki gibi. Eğer sizde 5. sıradaki liste yoksa sıkıntı olması normaldir.

TheNomAd · 26 Haziran 2020

Korhan Ayhan' Alıntı:
Sayfadaki gruplandırmayı kaldırıp kodları çalıştırdığımda bende ekteki sonuç çıkıyor. Sanırım sizde sıralama kodlarındaki 5 parametresi sorun yaratıyor.

Bende SIRALA menüsü aşağıdaki görüntüdeki gibi. Eğer sizde 5. sıradaki liste yoksa sıkıntı olması normaldir.

Ekli dosyayı görüntüle 219369

Eklediğiniz dosyayı açtığımda sorun ortadan kalktı fakat şimdi dikkatimi çeken sarı ile boyadığım iki durum oluştu.
1- Düzenlenmiş data sheetindeki satırlar termin tarihine (Geçmişten-Geleceğe) göre sıralanmıyor.
2- Aylık ebat dönüşü sheetinde çap birimine göre doğru pivot yapmıyor. Örnek: Çektiğim data dosyasında Termine göre Mayıs ayında 48,3 ebatı toplanıp 25,88 olmalı. Burada ise 3 ayrı satırda ton bilgileri de farklı bir değerde geliyor.

TheNomAd · 26 Haziran 2020

TheNomAd' Alıntı:
Düzeltme!
Eklediğiniz dosyayı açtığımda sorun ortadan kalktı fakat şimdi dikkatimi çeken sarı ile boyadığım iki durum oluştu.
1- Düzenlenmiş data sheetindeki satırlar termin tarihine (Geçmişten-Geleceğe) göre sıralanmıyor.
2- Aylık ebat dönüşü sheetinde çap birimine göre doğru pivot yapmıyor. Örnek: Çektiğim data dosyasında Termine göre Mayıs ayında 48,3 ebatı toplanıp 26 olmalı. Burada ise 3 ayrı satırda ton bilgileri de farklı bir değerde geliyor.

Korhan Ayhan · 26 Haziran 2020

Sıralama işlemi çözülür.

Mayıs ayındaki sıkıntıda çözülür. Fakat listenizde farklı yıllar var. Aylar özet hale getirilirken yıllar dikkate alınacak mı? Bu durumda nasıl bir tablo oluşacak?

TheNomAd · 26 Haziran 2020

Korhan Ayhan' Alıntı:
Sıralama işlemi çözülür.

Mayıs ayındaki sıkıntıda çözülür. Fakat listenizde farklı yıllar var. Aylar özet hale getirilirken yıllar dikkate alınacak mı? Bu durumda nasıl bir tablo oluşacak?

Ayrıca bir yıl sütunu da getirebiliriz Aylık ebat dönüş sheet'ine o zaman çözülebilir mi acaba?

Korhan Ayhan · 27 Haziran 2020

Deneyin bakalım olmuş mu?

Kapalı Dosyadan Veri Çekme

Korhan Ayhan

Administrator

TheNomAd

Korhan Ayhan

Administrator

TheNomAd

Korhan Ayhan

Administrator

Ekli dosyalar

TheNomAd

Ekli dosyalar

TheNomAd

Korhan Ayhan

Administrator

TheNomAd

Korhan Ayhan

Administrator

TheNomAd

TheNomAd

Korhan Ayhan

Administrator

TheNomAd

Ekli dosyalar

Korhan Ayhan

Administrator

Ekli dosyalar

TheNomAd

Ekli dosyalar

TheNomAd

Ekli dosyalar

Korhan Ayhan

Administrator

TheNomAd

Korhan Ayhan

Administrator

Ekli dosyalar