Kapalı excelden veri çekme hk.

[Haluk]

Korhan Bey, aslında "Null" kayıtların yazılıp yazılmaması çok da önemli değil diye düşünüyorum.... çünkü, bu alanlarla ilgili olarak yapılacak birşey istenmemiş soruda. Demek ki, kullanıcı bir şekilde bu alanlara daha sonra kendisi veri girecek.

Bahsettiğiniz hücrelerde LEN fonksiyonu ile kontrol yapıldığında "0" sonucu elde edildiğine göre, bir problem yok diye değerlendiriyorum.

Dediğiniz gibi, bu sadece bir alternnatif .... soruyu soran arkadaş bütün alternatifleri değerlendirip, kendisine en uygun olanı kullanacaktır.

.

 

[valentino06]

Sayın Haluk Hocam , Korhan Hocam,çok teşekkür ederim. gerçekten her iki hocam ikinizde mükemmelsiniz. Haluk hocam boşluklara veri girilecek. Allah'a Emanet olun. Tabi metin_0606 Hocayıda unutmamak gerekir. Her birinize ayrı ayrı teşekkür ederim. çok sağolun varolun.


Saygılarımla,

 

[valentino06]

Sayın Korhan Ayhan, Haluk,Metin006 Hocalarım öncellikle yazmış olduğunuz kodlar gerçekten çok güzel çalışıyor. çok teşekkür ederim.Hocalarım. İşPlanı Tablosunda aynı veriler birden fazla olduğunda acaba birleştirme yapabilirmiyiz. data kitabına tek olarak gelmelerini sağlayabilirmiyiz. Sadece Data sayfasında kg/Adam/saatleri A sutundaki Koda göre aynı olanların Toplamları getirtebilirmiyiz. Aynı olmayaları direk çekmesini sağlayabilirmiyiz.Çok teşekkür ederim.
Saygılarımla,

 

[Korhan Ayhan]

Deneyiniz.

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

    Zaman = Timer

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    Range("A8:B" & Rows.Count).ClearContents
    Range("G8:M" & Rows.Count).ClearContents

    Set Baglanti = CreateObject("AdoDb.Connection")

    Dosya = ThisWorkbook.Path & Application.PathSeparator & _
            "Örnek" & Application.PathSeparator & "İş Planı.xlsx"

    Baglanti.Open "Provider=Microsoft.Ace.OleDb.12.0;Data Source=" & _
    Dosya & ";Extended Properties=""Excel 12.0;Hdr=No"""

    Sorgu = "Select F1, F2 From [2020 $A3:N] Where F1 Is Not Null Group By F1, F2"
    Set Kayit_Seti = Baglanti.Execute(Sorgu)
    Range("A8").CopyFromRecordset Kayit_Seti

    Sorgu = "Select F5 From [2020 $A3:N] Where F1 Is Not Null Group By F1, F2, F5"
    Set Kayit_Seti = Baglanti.Execute(Sorgu)
    Range("G8").CopyFromRecordset Kayit_Seti

    Sorgu = "Select F8, F9, F10 From [2020 $A3:N] Where F1 Is Not Null Group By F1, F2, F8, F9, F10"
    Set Kayit_Seti = Baglanti.Execute(Sorgu)
    Range("H8").CopyFromRecordset Kayit_Seti

    Sorgu = "Select F6 From [2020 $A3:N] Where F1 Is Not Null Group By F1, F2, F6"
    Set Kayit_Seti = Baglanti.Execute(Sorgu)
    Range("K8").CopyFromRecordset Kayit_Seti

    Sorgu = "Select F11 From [2020 $A3:N] Where F1 Is Not Null Group By F1, F2, F11"
    Set Kayit_Seti = Baglanti.Execute(Sorgu)
    Range("L8").CopyFromRecordset Kayit_Seti
       
    Sorgu = "Select Sum(F12) From [2020 $A3:N] Where F1 Is Not Null Group By F1, F2"
    Set Kayit_Seti = Baglanti.Execute(Sorgu)
    Range("M8").CopyFromRecordset Kayit_Seti

    Kayit_Seti.Close
    Baglanti.Close

    Set Kayit_Seti = Nothing
    Set Baglanti = Nothing

    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True

    MsgBox "Veri aktarimi tamamlanmistir." & Chr(10) & Chr(10) & _
           "Islem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye", vbInformation
End Sub

 

[valentino06]

Sayın@Korhan Ayhan Hocam çok teşekkür ederim. kod çok güzel çalışıyor. Elinize ve Emeğinize Sağlık. Allah Yolunuzu Açık Etsin.
İyi günler Dilerim / Saygılarımla,

 

[valentino06]

Sayın Korhan Ayhan Hocam tabloda çalışma yaparken verilerin Data sayfasında "M" sütununda aşağıya doğru kayma yapıyor ve toplamlar gelmiyor. Hocam lütfen bakabilirmisiniz. verileri çektiğinizde sizde göreceksiniz.

 

[Korhan Ayhan]

#24 nolu mesajımdaki kodu revize ettim. Tekrar deneyiniz.

 

[valentino06]

Korhan Ayhan Hocam teşekkür ederim. Çok sağolun. Allah'a emanet olun.
İyi günler dilerim.
Saygılarımla,