• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Kapalı dosyadan cari kodu sorgulama

T

tahsinanarat

Altın Üye
Katılım
14 Mart 2005
Mesajlar
2,181
Excel Vers. ve Dili
Ofis 2019 Türkçe
Kapalı dosyada yıl boyunca yapılan satışlara ait dökümler bulunmakta olup, açık olan kapalı deneme.xlsx dosyasında üç ayrı kritere göre sorgulama yapmak istiyorum, A1 hücresinde başlangıç tarihi, b1 hücresinde bitiş tarihi ve c1 hücresinde ise cari kod yazmak suretiyle yazılan cari koda ait iki tarih aralığı yapılan satışların kapalı olan dosyadan çekilmesini istiyorum.
Örnek dosya ekte gönderilmiş olup, yardımcı olacak arkadaşlara şimdiden teşekkür ederim.
 

Ekli dosyalar

Merhaba
Boş bir module bu kodu ekleyip dener misiniz ?
Kod: 
Sub getir()
Dim EX As Excel.Application, K1 As Workbook, STR As Long
Dim S1 As Worksheet, S2 As Worksheet, YOL As String, AÇ As String
Set EX = CreateObject("Excel.Application")
EX.Visible = False
Application.ScreenUpdating = False
Set S1 = ActiveWorkbook.Sheets("Sayfa1")
S1.Range("A4:I" & Rows.Count).ClearContents
AÇ = ActiveCell.Address
YOL = ThisWorkbook.Path & "\"
Set K1 = EX.Workbooks.Open(YOL & "faturalar2016.xlsx")
Set S2 = K1.Sheets("Sayfa1")
STR = S2.Range("A" & Rows.Count).End(xlUp).Row
S2.Range("A1:I" & STR).AutoFilter 3, S1.Range("C1")
S2.Range("A1:I" & STR).AutoFilter 2, ">=" & CDbl(S1.Range("A1")), xlAnd, "<=" & CDbl(S1.Range("B1"))
S2.Range("J1") = "=SUBTOTAL(3,A2:A" & STR & ")"
If S2.Range("J1") > 0 Then
S2.Range("A2:I" & STR).Copy
S1.Range("A4").PasteSpecial (xlPasteValues)
End If
S2.Range("A1:I" & STR).AutoFilter
K1.Close 0: EX.Quit
Range(AÇ).Select
Application.ScreenUpdating = True
End Sub
 
Ado ile bu şekilde çözüm bulabilirsiniz.

Kod: 
[FONT="Trebuchet MS"][SIZE="2"]Sub Emre()
    Range("A4:I10000").ClearContents
    Set con = CreateObject("adodb.connection")
    con.Open "provider=microsoft.ace.oledb.12.0;data source=" & ThisWorkbook.Path & _
    "\faturalar2016.xlsx;extended properties=""excel 12.0;hdr=yes;imex=1"""
    bas = CLng(CDate(Range("A1").Value)): bit = CLng(CDate(Range("B1").Value)): kod = CStr(Range("C1").Value)
    sorgu = "select * from [Sayfa1$] where clng(cdate(Tarih)) >=" & bas & ""
    sorgu = sorgu & " and clng(cdate(tarih)) <=" & bit & " and [Cari Kod]='" & kod & "'"
    Set rs = con.Execute(sorgu)
    Range("A4").CopyFromRecordset rs
End Sub[/SIZE][/FONT]
 
Sn. asi_kral kotlarınızı uyguladım olumlu sonuç aldım, Sn. Murat Osma sizin kodlarınızı denediğimde Range("A4").CopyFromRecordset rs
satırında hata veriyor, bakabilirseniz sevinirim. ilginiz için sizlere çok teşekkür ediyorum. Ellerinize sağlık.
 
Ado ile alternatif.:cool:
Dosyanız ektedir.:cool:
Kod: 
Sub adoaktar59()
Dim conn As Object, rs As Object, ilktar As Date, sontar As Date
Dim kodno As String
ilktar = Range("A1").Value
sontar = Range("B1").Value
kodno = Range("C1").Value
Range("A4:I" & Rows.Count).ClearContents
Set conn = CreateObject("Adodb.connection")
Set rs = CreateObject("Adodb.recordset")
conn.Open "provider=microsoft.ace.oledb.12.0;data source=" & ThisWorkbook.Path & _
        "\faturalar2016.xlsx;extended properties=""excel 12.0;hdr=yes"""
rs.Open "select * From [Sayfa1$] where [Cari Kod]='" & kodno & _
    "' and format(Tarih,'yyyymmdd') between " _
    & Format(ilktar, "yyyymmdd") & " and " & Format(sontar, "yyyymmdd") & ";", conn, 1, 1
If rs.RecordCount > 0 Then Range("A4").CopyFromRecordset rs
rs.Close
conn.Close
Set rs = Nothing
Set conn = Nothing
MsgBox "Veriler aktarıldı." & vbLf & "evrengizlen@hotmail.com"
End Sub
 

Ekli dosyalar

Sn. Orion1 hocam elinize sağlık çok hızlı dataları çekiyor. Sağolasınız.
 
tahsinanarat' Alıntı:
Sn. asi_kral kotlarınızı uyguladım olumlu sonuç aldım, Sn. Murat Osma sizin kodlarınızı denediğimde Range("A4").CopyFromRecordset rs
satırında hata veriyor, bakabilirseniz sevinirim. ilginiz için sizlere çok teşekkür ediyorum. Ellerinize sağlık.
Genişletmek için tıkla ...
Dosyanız ektedir.​
 

Ekli dosyalar

Sn. Murat Osma, ilginiz için çok teşekkür ediyorum, kodlarınızı ayni isimli orijinal dosyamda deniyorum, yine aynı hatayı veriyor, hatta verileri çalışan dosya üzerine alıp deniyorum yine aynı hatayı alıyorum, hata resmi ektedir.
 

Ekli dosyalar

  • hatakodu.png
    hatakodu.png
    6.9 KB · Görüntüleme: 6
Sn. Orion1 hocam,
Kod: 
kodno = Range("C1").Value
birebir eşleşmesi gerekiyor, içinde geçen şeklinde arama istersek kodda nasıl bir değişiklik yapmam gerekiyor, bildiklerimi uyguladım ancak olmadı.
 
Bir deneme yapmıştım ama önerim olumlu sonuç vermediğinden cevabı sildim.
 
Son düzenleme:
Önerilen kodu aşağıdaki gibi değiştirip deneyiniz.

Kod: 
Sub adoaktar59()
    Dim conn As Object, rs As Object, ilktar As Date, sontar As Date
    Dim kodno As String
    ilktar = Range("A1").Value
    sontar = Range("B1").Value
    kodno = "%" & Range("C1").Value & "%"
    Range("A4:I" & Rows.Count).ClearContents
    Set conn = CreateObject("Adodb.connection")
    Set rs = CreateObject("Adodb.recordset")
    conn.Open "provider=microsoft.ace.oledb.12.0;data source=" & ThisWorkbook.Path & _
            "\faturalar2016.xlsx;extended properties=""excel 12.0;hdr=yes"""
    rs.Open "select * From [Sayfa1$] where [Cari Kod] like '" & kodno & _
        "' and format(Tarih,'yyyymmdd') between " _
        & Format(ilktar, "yyyymmdd") & " and " & Format(sontar, "yyyymmdd") & ";", conn, 1, 1
    If rs.RecordCount > 0 Then Range("A4").CopyFromRecordset rs
    rs.Close
    conn.Close
    Set rs = Nothing
    Set conn = Nothing
    MsgBox "Veriler aktarıldı." & vbLf & "evrengizlen@hotmail.com"
End Sub
 
tahsinanarat' Alıntı:
Sn. Murat Osma, ilginiz için çok teşekkür ediyorum, kodlarınızı ayni isimli orijinal dosyamda deniyorum, yine aynı hatayı veriyor, hatta verileri çalışan dosya üzerine alıp deniyorum yine aynı hatayı alıyorum, hata resmi ektedir.
Genişletmek için tıkla ...
Tahsin Bey, benim gönderdiğim dosyada muhtemelen hata almıyorsunuzdur?
Siz kodları alıp orijinal dosyanızda kullanıyorsunuz, kim bilir orijinal dosyanızdaki tablo yapısı nasıldır?

Geçersiz boş kullanımı hatasının sebebi şudur; tablolarınız sağlıklı veritabanı mantığında değildir.
Örneğin; A1 hücresi dolu iken B1 hücresi boş ise o zaman geçersiz boş kullanımı hatası alabilirsiniz.
Ya B1 hücresinde bir veri olmalı, ya da kodlarla B sütunu için boş değilse şartı ilave edilmelidir.

Evren Bey ve Korhan Bey size gerekli yardımlarda bulunmuşlar.

Saygılar
​
 
Son düzenleme:
Sn. Murat OSMA dediğiniz gibi veri tabanı olarak kullandığım dosyada günlere ait alt toplam satırları var, yani a sütununda Toplam yazıyor b ve c sütunları karşılığı boş, bu satırları kaldırdığımda çalıştı, Korhan hocamın kodları da içerir şekilde arama yaptı, demek ki veri tabanının çok düzenli olması gerekiyor, ama diğer önerilen kodlarda böyle bir sorun oluşmadı. İlgilenen herkese çok teşekkürler.
 
Sn. Orion1 hocam, Sn. Korhan hocam kapalı dosyadaki aranan değer bulunduğunda tüm satırı değil de bizim istediğimiz sütunları (örn. a,b,c,d veya a, d vs.) gibi sütunları almak istersek kodda nasıl bir değişiklik olmalıdır. Teşekkürler.
 
tahsinanarat' Alıntı:
Sn. Orion1 hocam, Sn. Korhan hocam kapalı dosyadaki aranan değer bulunduğunda tüm satırı değil de bizim istediğimiz sütunları (örn. a,b,c,d veya a, d vs.) gibi sütunları almak istersek kodda nasıl bir değişiklik olmalıdır. Teşekkürler.
Genişletmek için tıkla ...

Dosyanız ektedir.:cool:
Kod: 
rs.Open "select [Belge No],[Tarih],[Cari Kod],[Cari Ünvan] From [Sayfa1$] where [Cari Kod] like '" & _
    kodno & "' and format(Tarih,'yyyymmdd') between " _
    & Format(ilktar, "yyyymmdd") & " and " & Format(sontar, "yyyymmdd") & ";", conn, 1, 1
 

Ekli dosyalar

Sn. Orion1 Hocam çok teşekkür ediyorum, sayenizde çok şeyler öğreniyoruz, elinize sağlık.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst