Soru Verilen Tarihe eşit ve önceki en büyük tarihteki fiyat

emsey · 8 Mart 2023

Korhan Ayhan' Alıntı:
Çoklu veri için örnek dosya paylaşırsanız sorguyu revize edip kontrol edebilirim.

Üstad hemen ekledim. Şimdiden çok teşekkür ediyorum.

emsey · 13 Mart 2023

Saygılar @Korhan Ayhan üstad. Hiç bakma imkanın oldu mu? Olacak mı yapabilecek miyiz acaba

Korhan Ayhan · 13 Mart 2023

Deneyiniz.

C++:

Private Sub CommandButton1_Click()
    Dim My_Connection As Object, My_Query As String
    Dim My_Recordset As Object, Rng As Range
    Dim Process_Time As Double
       
    Process_Time = Timer
       
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
       
    Set My_Connection = CreateObject("AdoDB.Connection")
   
    Range("G2:H" & Rows.Count).ClearContents
   
    My_Connection.Open "Provider=Microsoft.Ace.OleDb.12.0;Data Source=" & _
    ThisWorkbook.FullName & ";Extended Properties=""Excel 12.0;Hdr=Yes"""
   
    For Each Rng In Range("A2:B" & Cells(Rows.Count, 1).End(3).Row).Columns(1).Cells
        My_Query = "Select Top 1 Tarih,AlisFiyati From [Alis$] " & _
                   "Where Tarih <= " & CLng(Rng) & " And StokKodu = '" & Rng.Offset(, 1) & "' Order By Tarih Desc"
        
        Set My_Recordset = My_Connection.Execute(My_Query)
        
        Cells(Rng.Row, "G").CopyFromRecordset My_Recordset
   
        If My_Recordset.State <> 0 Then My_Recordset.Close
    Next
    
    If My_Connection.State <> 0 Then My_Connection.Close
   
    Set Rng = Nothing
    Set My_Recordset = Nothing
    Set My_Connection = Nothing
   
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
   
    MsgBox "İşleminiz tamamlanmıştır." & vbCrLf & _
           "İşlem süresi ; " & Format(Timer - Process_Time, "0.00") & " Saniye", vbInformation
End Sub

emsey · 14 Mart 2023

Korhan Ayhan' Alıntı:

Deneyiniz.

C++:

Private Sub CommandButton1_Click()
    Dim My_Connection As Object, My_Query As String
    Dim My_Recordset As Object, Rng As Range
    Dim Process_Time As Double
      
    Process_Time = Timer
      
    Application.ScreenUpdating = False
      
    Set My_Connection = CreateObject("AdoDB.Connection")
  
    Range("G2:H" & Rows.Count).ClearContents
  
    My_Connection.Open "Provider=Microsoft.Ace.OleDb.12.0;Data Source=" & _
    ThisWorkbook.FullName & ";Extended Properties=""Excel 12.0;Hdr=Yes"""
  
    For Each Rng In Range("A2:B" & Cells(Rows.Count, 1).End(3).Row).Columns(1).Cells
        My_Query = "Select Top 1 Tarih,AlisFiyati From [Alis$] " & _
                   "Where Tarih <= " & CLng(Rng) & " And StokKodu = '" & Rng.Offset(, 1) & "'"
       
        Set My_Recordset = My_Connection.Execute(My_Query)
       
        Cells(Rng.Row, "G").CopyFromRecordset My_Recordset
  
        If My_Recordset.State <> 0 Then My_Recordset.Close
    Next
   
    If My_Connection.State <> 0 Then My_Connection.Close
  
    Set Rng = Nothing
    Set My_Recordset = Nothing
    Set My_Connection = Nothing
  
    Application.ScreenUpdating = True
  
    MsgBox "İşleminiz tamamlanmıştır." & vbCrLf & _
           "İşlem süresi ; " & Format(Timer - Process_Time, "0.00") & " Saniye", vbInformation
End Sub

Korhan hocam tekrar tekrar emeklerine sağlık kodları denedim çalışıyor ancak Tarih <= " & CLng(Rng) yapmıyor. Örneğin satış tarihi 7.03.2013, alış tarihini getirecek ancak son alım tarihi 03.03.2023 tarihinde olmasına rağmen 01.03.2023 tarihini ve fiyatı getiriyor. Yani 07.03.2013 tarihindeki alış varsa 07.03.2013 tarihini yoksa bu tarihten önceki son alımın tarihi ve fiyatı getirmesi lazımken çalışmadı. Ben örnek dosyayı ekledim hatayı hücrede sarı ile boyadım.

Korhan Ayhan · 14 Mart 2023

Önerdiğim kodu revize ettim. Tekrar deneyiniz.

emsey · 14 Mart 2023

Korhan Ayhan' Alıntı:
Önerdiğim kodu revize ettim. Tekrar deneyiniz.

evet üstad çalıştı normalde uzun sürdü ancak order by sonrasında iyice süre uzadı 173 saniye sürüyor. her defasında exceldeki veriler yenilenince çok meşakkatli olacak. Burada sorguylada hesaplama hızlı olmadı. Bu veriyi Power bi'a aktarıp patronlara rapor yapıyorum orada çözemedim daha iyi olduğum excel üzerinde çözüp power bi'ya çekeyim dedim ama excelde max formülü ile de sorgu ile de çok uzun sürüyor. Power query içinde veya Power Bı'da bir çözüm bulabileceğim bir kaynak bulmam gerekiyor gibi görünüyor. Power bi üzerinde bu komutu yapabilseydim belki de çok hızlı olacaktı. İterasyon gibi sumx gibi bir şeyler ama yapamadım.

Korhan Ayhan · 14 Mart 2023

Bende verdiğim cevabı süre olarak beğenmedim...

Aslında daha hızlı sonuç alınabilir. Ben ADO ile ilgili sorguyu yazmayı beceremedim. Hız olarak avantajlı sorguyu yazabilirsem paylaşırım.

emsey · 14 Mart 2023

Korhan Ayhan' Alıntı:
Bende verdiğim cevabı süre olarak beğenmedim...

Aslında daha hızlı sonuç alınabilir. Ben ADO ile ilgili sorguyu yazmayı beceremedim. Hız olarak avantajlı sorguyu yazabilirsem paylaşırım.

Tamam üstad çok teşekkür ederim. Çok düşüncelisin çok sağolasın

emsey · 15 Mart 2023

@Korhan Ayhan üstadım tekrardan merhabalar. Bazen saatlerce ben koda bakıyorum kod bana bakıyor o arada beynimde kodu çalıştırıyorum falan derken beyin duruyor. Aşağıdaki şekilde çözdüm burada paylaşmak istedim. Sende bir bak istersen. Ekleme/çıkarma revize belki bir dokunuşun olur ve başkasına da faydası olur diye düşündüm. Bu haliyle müthiş hızlı oldu. Tek sıkıntım şu oldu. Alış fiyatında aynı tarihte iki fiyat varsa hangisini alacak. Tarih hanesine acaba saat tarih şeklinde yapsak son tarihi nasıl aldırırız. Şuanda aynı tarihte iki alış fiyatı varsa büyüğü alıyor. Aynı tarihte birden fazla alış fiyatı varsa (fiyatta düşmüşte olabilir.) son tarihli (aslında son tarih saatli) olanın fiyatını alması lazımdı. Yüzdüm yüzdüm kuyruğuna geldim.

Kodlar şu şekilde: ADO ile her zamanki gibi çok hızlı oldu.

Kod:

Private Sub CommandButton1_Click()
Dim baglanti As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim sorgu As String


baglanti.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & _
            ";Extended Properties=""Excel 12.0;HDR=Yes;Hdr=Yes"""
          

sorgu = "Select [satis$].[TARİH],[satis$].[STOK KODU],[satis$].[STOK AÇIKLAMA],MAX([fiyat$].[TARİH]), MAX([fiyat$].[ALIŞ FİYATI]) FROM [satis$],[fiyat$] " & _
" where [satis$].[STOK KODU] = [fiyat$].[STOK KODU] AND " & _
" [fiyat$].[TARİH] <= [satis$].[TARİH] AND [fiyat$].[TARİH] = [satis$].[TARİH] " & _
"group by [satis$].[TARİH],[satis$].[STOK KODU],[satis$].[STOK AÇIKLAMA]" & _
"ORDER BY [satis$].[STOK KODU]"

rs.Open sorgu, baglanti
Range("a2:f100000").ClearContents
Range("a2").CopyFromRecordset rs
baglanti.Close
Set rs = Nothing
End Sub

Edit: Yine olmamış boşa sevinmişim satışların tüm tarihleri alması lazım. satış tarihi ile alış tarihi eşitlendiği için satış tarihi ile alış tarihi geliyor. Canım iyice sıkıldı şimdi.

Korhan Ayhan · 16 Mart 2023

Merhaba,

Birkaç gündür boş kaldıkça ara ara bu konuyu irdeliyordum. ADO ile ilgili sorguyu bir türlü oluşturamadım. Alış tarihi olarak maksimum tarihi getiren kodu oluşturdum. Fakat satış tarihinden küçük maksimum alış tarihini getirecek sorguyu oluşturamadım. Ben kullanılacak sorgunun daha basit olacağını düşünüyordum.

Sonra aklıma yapay zekadan faydalanmak geldi. Ona bu soruyu sordum ve bana aşağıdaki sorguyu önerdi. Fakat ben bunu excel dosyasına uyarlamama rağmen çalıştıramadım. Belki tecrübeli üstadlar bu konuda destek olabilirler.

C++:
Soru : Envanter koduna göre iki tablo arasında satış tarihinden önceki en büyük alış tarihinin birim fiyatı ve tarihinin döndürülmesi

Yanıt;
"Satış" ve "Envanter" olmak üzere iki tablonuz olduğunu ve bunların aşağıdaki sütunlara sahip olduğunu varsayarsak:

Satış: indirim_tarihi, envanter_kodu, miktar, indirim_fiyatı

Envanter: envanter_kodu, birim_fiyat

Ve "Satışlar" tablosundaki her bir satış için satış tarihinden önceki en büyük satın alma tarihinin birim fiyatını ve tarihini döndürmek istiyorsunuz.
Aşağıdaki SQL sorgusunu kullanabilirsiniz:

C++:

SELECT s.sale_date, s.inventory_code, s.quantity, s.sale_price, i.unit_price, MAX(i.purchase_date) AS purchase_date FROM Sales s LEFT JOIN ( SELECT inventory_code, unit_price, purchase_date FROM Inventory i1 WHERE purchase_date < ALL ( SELECT purchase_date FROM Inventory i2 WHERE i2.purchase_date >= s.sale_date AND i2.inventory_code = i1.inventory_code ) ) i ON s.inventory_code = i.inventory_code GROUP BY s.sale_date, s.inventory_code, s.quantity, s.sale_price, i.unit_price

Açıklama:
Sorgu önce "Satış" tablosunu, her stok kodu için satış tarihinden daha az olan en son satın alma tarihini seçen bir alt sorguyla birleştirir. Bu, satın alma tarihinin satış tarihinden daha büyük olan aynı envanter kodu için tüm satın alma tarihlerinden daha küçük olduğu tüm satırları döndüren "ALL" anahtar kelimesiyle bir alt sorgu kullanılarak yapılır.
Birleştirmenin sonucu, karşılık gelen satın alma tarihi olmasa bile tüm satışları içerir. Bunu halletmek için, sol tablodaki tüm satırları (Satış) ve varsa sağ tablodaki eşleşen satırları (Envanter) döndüren bir SOL BİRLEŞTİRME kullanırız. Sağ tabloda eşleşen satır yoksa, sağ tablo sütunlarının değerleri NULL olacaktır.
Son olarak sorgu, sonucu seçtiğimiz sütunlara göre gruplandırır ve MAX() işlevini kullanarak her grup için maksimum satın alma tarihini döndürür.

Korhan Ayhan · 16 Mart 2023

Ekteki dosyada biraz ado ve dizi yöntemiyle daha iyi performans sağlayan bir çözüm hazırladım. Belki kullanmak istersiniz.

emsey · 16 Mart 2023

@Korhan Ayhan üstad gayet hızlı olmuş gerçek dosyamda deneyeceğim yalnız kodlama harika emeğine yüreğine sağlık.

emsey · 17 Mart 2023

Korhan Ayhan' Alıntı:
Merhaba,

Birkaç gündür boş kaldıkça ara ara bu konuyu irdeliyordum. ADO ile ilgili sorguyu bir türlü oluşturamadım. Alış tarihi olarak maksimum tarihi getiren kodu oluşturdum. Fakat satış tarihinden küçük maksimum alış tarihini getirecek sorguyu oluşturamadım. Ben kullanılacak sorgunun daha basit olacağını düşünüyordum.

Sonra aklıma yapay zekadan faydalanmak geldi. Ona bu soruyu sordum ve bana aşağıdaki sorguyu önerdi. Fakat ben bunu excel dosyasına uyarlamama rağmen çalıştıramadım. Belki tecrübeli üstadlar bu konuda destek olabilirler.

Bende excelde her türlü test ettim uyarlamaya çalıştım. [ ] parantezli, parantezsiz AS ile isimleri çalıştım bir yerde hata veriyor anlamadım. Uyarlamaya çalıştığım hali aşağıdaki gibidir.

Kod:

sorgu = "SELECT [s].[sale_date], [s].[inventory_code], [s].[quantity], [s].[sale_price], [i].[unit_price], MAX([i].[purchase_date]) AS [purchase_date] " & _
        "FROM [Sales$] as [s]" & _
        "LEFT JOIN (" & _
        "SELECT [inventory_code], [unit_price], [purchase_date]" & _
        "FROM [Inventory$] as [i1]" & _
        "WHERE [purchase_date] < ALL (" & _
        "SELECT [purchase_date]" & _
        "FROM [Inventory$] as [i2]" & _
        "WHERE [i2].[purchase_date] >= [s].[sale_date]" & _
        "AND [i2].[inventory_code] = [i1].[inventory_code])) as [i] " & _
        "ON [s].[inventory_code] = [i].[inventory_code]" & _
        "GROUP BY [s].[sale_date], [s].[inventory_code], [s].[quantity], [s].[sale_price], [i].[unit_price]"

dost · 19 Mart 2023

Merhaba,

Aşağıdaki kodu dener misiniz. Altın üyeliğimi yenilememe rağmen henüz aktif olmadı o yüzden sizin datanızda test edemedim.

C++:

Sub GetPriceFromMaxDate()
    Dim cn As Object
    Dim rs As Object
    Dim strSQL As String
    Dim sh1 As Worksheet
    Dim Process_Time As Double
      
    Application.ScreenUpdating = False
    
    Process_Time = Timer
    
    Set cn = CreateObject("ADODB.Connection")
    cn.ConnectionString = "Provider=Microsoft.Ace.OleDb.12.0;Data Source=" & _
    ThisWorkbook.FullName & ";Extended Properties=""Excel 12.0;Hdr=Yes"""
    cn.Open
    
    strSQL = "SELECT s.[STOK KODU], s.[TARİH], s.[SATIŞ FİYATI], i.[ALIŞ FİYATI] " & _
            "FROM [Satış$] s " & _
            "INNER JOIN [Alış$] i ON s.[STOK KODU] = i.[STOK KODU] WHERE i.[TARİH] = " & _
                "(SELECT MAX([TARİH]) " & _
                "FROM [Alış$] i2 " & _
                "WHERE i2.[STOK KODU] = s.[STOK KODU] And i2.[TARİH] <= s.[TARİH] ) "
    
    Set sh1 = Sheets("Sonuç")
    
    Set rs = cn.Execute(strSQL)
    
    sh1.Range("A2:D" & sh1.Rows.Count).ClearContents
    sh1.Range("A1:D1").Value = Array("Stok Kodu", "Satış Tarihi", "Satış Fiyatı", "Alış Fiyatı")
    sh1.Range("A2").CopyFromRecordset rs

    rs.Close
    cn.Close
    
    Set rs = Nothing:   Set cn = Nothing:   Set sh1 = Nothing
    
    Application.ScreenUpdating = True
  
    MsgBox "İşleminiz tamamlanmıştır." & vbCrLf & _
           "İşlem süresi ; " & Format(Timer - Process_Time, "0.00") & " Saniye", vbInformation
    
End Sub

emsey · 19 Mart 2023

emsey' Alıntı:
@Korhan Ayhan üstad gayet hızlı olmuş gerçek dosyamda deneyeceğim yalnız kodlama harika emeğine yüreğine sağlık.

EGerçek dosyada test ettim üstad bu kodlar gayet hızlı oldu. Mart ayına kadar ilk 3 aylık veride hız yeterli. Dönem içinde tekrar değerlendiririz. Bu kodları uyarlayacağım emeğine sağlık.

emsey · 19 Mart 2023

dost' Alıntı:

Merhaba,

Aşağıdaki kodu dener misiniz. Altın üyeliğimi yenilememe rağmen henüz aktif olmadı o yüzden sizin datanızda test edemedim.

C++:

Sub GetPriceFromMaxDate()
    Dim cn As Object
    Dim rs As Object
    Dim strSQL As String
    Dim sh1 As Worksheet
    Dim Process_Time As Double
     
    Application.ScreenUpdating = False
   
    Process_Time = Timer
   
    Set cn = CreateObject("ADODB.Connection")
    cn.ConnectionString = "Provider=Microsoft.Ace.OleDb.12.0;Data Source=" & _
    ThisWorkbook.FullName & ";Extended Properties=""Excel 12.0;Hdr=Yes"""
    cn.Open
   
    strSQL = "SELECT s.[STOK KODU], s.[TARİH], s.[SATIŞ FİYATI], i.[ALIŞ FİYATI] " & _
            "FROM [Satış$] s " & _
            "INNER JOIN [Alış$] i ON s.[STOK KODU] = i.[STOK KODU] WHERE i.[TARİH] = " & _
                "(SELECT MAX([TARİH]) " & _
                "FROM [Alış$] i2 " & _
                "WHERE i2.[STOK KODU] = s.[STOK KODU] And i2.[TARİH] <= s.[TARİH] ) "
   
    Set sh1 = Sheets("Sonuç")
   
    Set rs = cn.Execute(strSQL)
   
    sh1.Range("A2:D" & sh1.Rows.Count).ClearContents
    sh1.Range("A1:D1").Value = Array("Stok Kodu", "Satış Tarihi", "Satış Fiyatı", "Alış Fiyatı")
    sh1.Range("A2").CopyFromRecordset rs

    rs.Close
    cn.Close
   
    Set rs = Nothing:   Set cn = Nothing:   Set sh1 = Nothing
   
    Application.ScreenUpdating = True
 
    MsgBox "İşleminiz tamamlanmıştır." & vbCrLf & _
           "İşlem süresi ; " & Format(Timer - Process_Time, "0.00") & " Saniye", vbInformation
   
End Sub

Sorgu ile excel dondu yanıt vermedi. Çok uzun bekledim ama çözülmedi. Veri az olunca stabil olur ama veri çok olunca çok kasıyor. Sadece Ado ile sorgu yaparak çözmek istedim ama sanırım hızlı bir şekilde olmuyor.

Soru Verilen Tarihe eşit ve önceki en büyük tarihteki fiyat

emsey

Ekli dosyalar

emsey

Korhan Ayhan

Administrator

emsey

Ekli dosyalar

Korhan Ayhan

Administrator

emsey

Korhan Ayhan

Administrator

emsey

emsey

Korhan Ayhan

Administrator

Korhan Ayhan

Administrator

Ekli dosyalar

emsey

emsey

dost

emsey

emsey