Koşullu Veri Çekme Hk.

[mertatakan3838]

Excel Versiyonu

Excel 2016

Excel Sürümü

64 Bit

Excel Dili

Türkçe

Değerli arkadaşlar LİSTE ve VERİ AKTARMA isminde 2 adet çalışma kitabım var. VERİ AKTARMA açık, LİSTE kapalı dosya olacak. LİSTE isimli sayfa veriler eklendikçe yenilenmektedir. Benim yapmak istediğim LİSTE isimli sayfadaki F sütunundaki verileri VERİ AKTARMA isimli sayfanın A sütununa LİSTENİN H sütunundaki verileri VERİNİN E sütununa LİSTENİN I sütununu VERİNİN F sütununa çekmek istiyorum ve çekilen her verinin karşılığına VERİ AKTARMA sayfasında J sütununda İşten Ayrıldı yazdırmak istiyorum. LİSTE isimli sayfada veriler işlem oldukça eski verilerin devamından itibaren eklenerek yenilenmektedir. Bunun için LİSTE isimli sayfadan veri çekerken önceden çektiğim verileri getirmemesi için bir kontrol mekanizması yapabilir miyiz. Örneğin en son çektiğim verilerin tarihini bir yere yazdırıp onun üzerinden kontrol yaptırabilir miyiz. Yeni LİSTE isimli sayfada yeni veriler eklendikçe eski çektiğim veriler gelmesin yeni çekeceğim veriler gelsin istiyorum. Yardımlarınız için şimdiden teşekkürler

 

Gizli Sütunları İhtiyaç Kadar Tek Tek Açma

VBA çalıştığında Z4 hücresi B3 hücresine yazsın

[Feyzullah]

Sub verick()
'FeyzullahK / Metehan8001 /'
    Set con = VBA.CreateObject("adodb.Connection")
    Set rs = VBA.CreateObject("adodb.Recordset")
    dosya_yolu = ThisWorkbook.Path & "\"
    dosya = dosya_yolu & "LİSTE.xlsx"
    Son_Tarih = Range("N1").Value
        con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
        dosya & ";extended properties=""Excel 12.0;hdr=Yes"""
    If Range("N1") = "" Then sorgu = "Select [T#C#],[İşten Çıkış Tarihi],[Çıkış Sebebi] From [İşten Çıkış Listesi$]"
    If IsDate(Range("N1")) = True Then sorgu = "Select [T#C#],[İşten Çıkış Tarihi],[Çıkış Sebebi] From [İşten Çıkış Listesi$] Where cdate([İşten Çıkış Tarihi])> '" & Range("N1") & "' "
    On Error Resume Next
    rs.Open sorgu, con, 1, 1
    If Err.Number = "3001" Then MsgBox "Hata - N1 hücresinde tarih değeri olmayabilir", vbCritical, "Hata....": Exit Sub
    If Err.Number = "-2147217900" Then MsgBox "Hata - N1 hücresinde bulunan tarihten sonra çıkış olmaya bilir...", vbCritical, "Hata....": Exit Sub
    If Err.Number = "-2147217865" Then MsgBox "Hata - Dosya adı hatalı olabilir", vbCritical, "Hata....": Exit Sub
    If Err.Number = "-2147217904" Then MsgBox "Hata - Sütun başlıklarında hatalı yazım olabilir", vbCritical, "Hata....": Exit Sub
    On Error GoTo 0
    If rs.RecordCount > 0 Then
        Do While Not rs.EOF
        say = say + 1
            son = Cells(Rows.Count, 1).End(xlUp).Row + 1
            Cells(son, 1) = rs(0).Value
            Cells(son, 5) = rs(1).Value
            Cells(son, 6) = rs(2).Value
            Cells(son, 10) = "İşten Ayrıldı"
        If rs.RecordCount = say Then Exit Do
        rs.movenext
        Loop
    End If
   Range("n1") = Format(Cells(son - 1, 5), "dd.mm.yyyy")
MsgBox "İşlem Tamamlandı..." & vbCrLf & vbCrLf & "Son Tarih: " & Range("N1").Value & _
" N1 hücresine kaydedilmiştir." & vbCrLf & vbCrLf & "Bu tarihten sonraki çıkışlar eklenmeyecektir" _
, vbInformation, "İşlem Tamamlandı - FeyzullahK"
End Sub

 

[mertatakan3838]

Sub verick()
'FeyzullahK / Metehan8001 /'
    Set con = VBA.CreateObject("adodb.Connection")
    Set rs = VBA.CreateObject("adodb.Recordset")
    dosya_yolu = ThisWorkbook.Path & "\"
    dosya = dosya_yolu & "LİSTE.xlsx"
    Son_Tarih = Range("N1").Value
        con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
        dosya & ";extended properties=""Excel 12.0;hdr=Yes"""
    If Range("N1") = "" Then sorgu = "Select [T#C#],[İşten Çıkış Tarihi],[Çıkış Sebebi] From [İşten Çıkış Listesi$]"
    If IsDate(Range("N1")) = True Then sorgu = "Select [T#C#],[İşten Çıkış Tarihi],[Çıkış Sebebi] From [İşten Çıkış Listesi$] Where cdate([İşten Çıkış Tarihi])> '" & Range("N1") & "' "
    On Error Resume Next
    rs.Open sorgu, con, 1, 1
    If Err.Number = "3001" Then MsgBox "Hata - N1 hücresinde tarih değeri olmayabilir", vbCritical, "Hata....": Exit Sub
    If Err.Number = "-2147217900" Then MsgBox "Hata - N1 hücresinde bulunan tarihten sonra çıkış olmaya bilir...", vbCritical, "Hata....": Exit Sub
    If Err.Number = "-2147217865" Then MsgBox "Hata - Dosya adı hatalı olabilir", vbCritical, "Hata....": Exit Sub
    If Err.Number = "-2147217904" Then MsgBox "Hata - Sütun başlıklarında hatalı yazım olabilir", vbCritical, "Hata....": Exit Sub
    On Error GoTo 0
    If rs.RecordCount > 0 Then
        Do While Not rs.EOF
        say = say + 1
            son = Cells(Rows.Count, 1).End(xlUp).Row + 1
            Cells(son, 1) = rs(0).Value
            Cells(son, 5) = rs(1).Value
            Cells(son, 6) = rs(2).Value
            Cells(son, 10) = "İşten Ayrıldı"
        If rs.RecordCount = say Then Exit Do
        rs.movenext
        Loop
    End If
   Range("n1") = Format(Cells(son - 1, 5), "dd.mm.yyyy")
MsgBox "İşlem Tamamlandı..." & vbCrLf & vbCrLf & "Son Tarih: " & Range("N1").Value & _
" N1 hücresine kaydedilmiştir." & vbCrLf & vbCrLf & "Bu tarihten sonraki çıkışlar eklenmeyecektir" _
, vbInformation, "İşlem Tamamlandı - FeyzullahK"
End Sub

Feyzullah Bey çok teşekkür ederim zihninize sağlık tam istediğim gibi olmuş

 

[mertatakan3838]

Feyzullah Bey çok teşekkür ederim zihninize sağlık tam istediğim gibi olmuş
[/QUOTE
Feyzullah Bey bir kaç denemeden sonra verileri almadı. Örneğin 23.06.2020 tarihinden sonraki verileri getirmiyor. Çok uğraştım ama çözemedim. ilgilenirseniz sevinirim. Dosyaları işlem yapmayan hali ile paylaşıyorum

 

[Feyzullah]

Pc başında bakarım dosyalara ama liste sayfasına yeni eklediğin verilerin hücre biçimleri ile ilgili bir durum olabilir.