- Katılım
- 28 Haziran 2019
- Mesajlar
- 3
- Excel Vers. ve Dili
- Excel 2016 - Türkçe
Merhaba
Forma yeni üye oldum
excel vba ile muhasbee finans ön muhasebe banka gibi işlerimde vba ile işlemler yapıyorum
zaman çözemediğim sorunlarla karşılaşıyorum
bu tür konularda sizden yardım rica etmek için forma üye oldum
Şu an takıldığım bir konu var
Aşağıdaki kod birden fazla stoğu olan ürünleri tek liste olarak listeliyor
en yakın tarihi alıyor
hatası şu liste eksik geliyor
Sub LISTELE_TAMAMLANAN_tarih_ayni_ise()
Dim son As Long
son = Range("D65536").End(3).Row
Zaman = Timer
On Error Resume Next
ActiveSheet.ShowAllData
On Error GoTo 0
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
.EnableEvents = False
End With
Set con = VBA.CreateObject("adodb.Connection")
Set RS = VBA.CreateObject("adodb.Recordset")
con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
ThisWorkbook.FullName & ";extended properties=""Excel 12.0;hdr=yes"""
Range("P3:T" & Rows.Count).ClearContents
Set RS = VBA.CreateObject("adodb.Recordset")
sorgu = "Select Distinct t.[Stok_Kodu],t.[Stok_Adı],t.Tarih,t.Çıkan,t.Fiyat from [Tek_Liste$] t " & _
" inner join (SELECT [Stok_Adı],MAX([Tarih]) as tarih1,MAX([Fiyat]) as fiyat1 FROM [Tek_Liste$] " & _
" WHERE [Cari Ünvan] = '" & Range("P1").Value & "' GROUP BY [Stok_Adı]) a " & _
" on a.[Stok_Adı] = t.[Stok_Adı] and a.tarih1 = t.[Tarih] and a.fiyat1 = t.[Fiyat]" & _
" where t.[Cari Ünvan] = '" & Range("P1").Value & "' order by t.[Stok_Adı]"
RS.Open sorgu, con
Range("P3").CopyFromRecordset RS
sorgu = ""
Range("p1") = Range("p1")
With Application
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
.EnableEvents = True
End With
Range("P1").Select
MsgBox "İşleminiz Tamamlanmıştır. " & Chr(10) & Chr(10) & _
"İşlem Süresi : " & Format((Timer - Zaman) / 60, "0.00") & " Saniye", vbInformation, "VEDAT ÖZER"
End Sub
Forma yeni üye oldum
excel vba ile muhasbee finans ön muhasebe banka gibi işlerimde vba ile işlemler yapıyorum
zaman çözemediğim sorunlarla karşılaşıyorum
bu tür konularda sizden yardım rica etmek için forma üye oldum
Şu an takıldığım bir konu var
Aşağıdaki kod birden fazla stoğu olan ürünleri tek liste olarak listeliyor
en yakın tarihi alıyor
hatası şu liste eksik geliyor
Sub LISTELE_TAMAMLANAN_tarih_ayni_ise()
Dim son As Long
son = Range("D65536").End(3).Row
Zaman = Timer
On Error Resume Next
ActiveSheet.ShowAllData
On Error GoTo 0
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
.EnableEvents = False
End With
Set con = VBA.CreateObject("adodb.Connection")
Set RS = VBA.CreateObject("adodb.Recordset")
con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
ThisWorkbook.FullName & ";extended properties=""Excel 12.0;hdr=yes"""
Range("P3:T" & Rows.Count).ClearContents
Set RS = VBA.CreateObject("adodb.Recordset")
sorgu = "Select Distinct t.[Stok_Kodu],t.[Stok_Adı],t.Tarih,t.Çıkan,t.Fiyat from [Tek_Liste$] t " & _
" inner join (SELECT [Stok_Adı],MAX([Tarih]) as tarih1,MAX([Fiyat]) as fiyat1 FROM [Tek_Liste$] " & _
" WHERE [Cari Ünvan] = '" & Range("P1").Value & "' GROUP BY [Stok_Adı]) a " & _
" on a.[Stok_Adı] = t.[Stok_Adı] and a.tarih1 = t.[Tarih] and a.fiyat1 = t.[Fiyat]" & _
" where t.[Cari Ünvan] = '" & Range("P1").Value & "' order by t.[Stok_Adı]"
RS.Open sorgu, con
Range("P3").CopyFromRecordset RS
sorgu = ""
Range("p1") = Range("p1")
With Application
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
.EnableEvents = True
End With
Range("P1").Select
MsgBox "İşleminiz Tamamlanmıştır. " & Chr(10) & Chr(10) & _
"İşlem Süresi : " & Format((Timer - Zaman) / 60, "0.00") & " Saniye", vbInformation, "VEDAT ÖZER"
End Sub