Tablo yardımı

[Mehmet Sait]

Merhabalar,

Dosya içerisinde bulunan iki farklı tablodan liste halinde veri çekmek istiyorum.

1 - Stok tablosunda negatif seviyeye düşen ürünler,
2 - Fiyat listesi tablosunda fiyatı olmayan ürünler,

Bu bilgileri uyarı amaçlı olarak bir önceki sayfada nasıl görebilirim.

Örnek dosya ektedir.

Yardımlarınız için teşekkür ederim.

 

[Erdem Akdemir]

Merhaba,

Aşağıdaki kodu deneyiniz.
Stok ve Fiyat Listesi sayfalarındaki boşlukları kaldırdım.
Örnek dosyanız ektedir.

Sub dunya()

Sheets("sayfa1").Range("C7:E1000").ClearContents
Sheets("sayfa1").Range("H7:I1000").ClearContents

Set con = VBA.CreateObject("adodb.Connection")

con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
ThisWorkbook.FullName & ";extended properties=""Excel 12.0;hdr=yes"""

sorgu = "select Kod, [Ürün adı],[Bakiye] from[Stok$] where bakiye < 0 "
Set rs = con.Execute(sorgu)

Sheets("sayfa1").Range("C7").CopyFromRecordset rs

sorgu = "select Kod, [Ürün adı],Fiyatı from[Fiyat Listesi$] where fiyatı is null "
Set rs = con.Execute(sorgu)

Sheets("sayfa1").Range("H7").CopyFromRecordset rs

End Sub

 

[Mehmet Sait]

Merhaba,

Aşağıdaki kodu deneyiniz.
Stok ve Fiyat Listesi sayfalarındaki boşlukları kaldırdım.
Örnek dosyanız ektedir.

Sub dunya()

Sheets("sayfa1").Range("C7:E1000").ClearContents
Sheets("sayfa1").Range("H7:I1000").ClearContents

Set con = VBA.CreateObject("adodb.Connection")

con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
ThisWorkbook.FullName & ";extended properties=""Excel 12.0;hdr=yes"""

sorgu = "select Kod, [Ürün adı],[Bakiye] from[Stok$] where bakiye < 0 "
Set rs = con.Execute(sorgu)

Sheets("sayfa1").Range("C7").CopyFromRecordset rs

sorgu = "select Kod, [Ürün adı],Fiyatı from[Fiyat Listesi$] where fiyatı is null "
Set rs = con.Execute(sorgu)

Sheets("sayfa1").Range("H7").CopyFromRecordset rs

End Sub

Yardımlarınız için teşekkür ederim

 

[Mehmet Sait]

Merhaba,

Aşağıdaki kodu deneyiniz.
Stok ve Fiyat Listesi sayfalarındaki boşlukları kaldırdım.
Örnek dosyanız ektedir.

Sub dunya()

Sheets("sayfa1").Range("C7:E1000").ClearContents
Sheets("sayfa1").Range("H7:I1000").ClearContents

Set con = VBA.CreateObject("adodb.Connection")

con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
ThisWorkbook.FullName & ";extended properties=""Excel 12.0;hdr=yes"""

sorgu = "select Kod, [Ürün adı],[Bakiye] from[Stok$] where bakiye < 0 "
Set rs = con.Execute(sorgu)

Sheets("sayfa1").Range("C7").CopyFromRecordset rs

sorgu = "select Kod, [Ürün adı],Fiyatı from[Fiyat Listesi$] where fiyatı is null "
Set rs = con.Execute(sorgu)

Sheets("sayfa1").Range("H7").CopyFromRecordset rs

End Sub

Hocam,

Eğer fiyat kısmı boş değilde sıfır yazılı ise bu satırı
sorgu = "select Kod, [Ürün adı],Fiyatı from[Fiyat Listesi$] where fiyatı is null " nasıl düzenlemek gerekir

 

[Mehmet Sait]

Merhaba,

Aşağıdaki kodu deneyiniz.
Stok ve Fiyat Listesi sayfalarındaki boşlukları kaldırdım.
Örnek dosyanız ektedir.

Sub dunya()

Sheets("sayfa1").Range("C7:E1000").ClearContents
Sheets("sayfa1").Range("H7:I1000").ClearContents

Set con = VBA.CreateObject("adodb.Connection")

con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
ThisWorkbook.FullName & ";extended properties=""Excel 12.0;hdr=yes"""

sorgu = "select Kod, [Ürün adı],[Bakiye] from[Stok$] where bakiye < 0 "
Set rs = con.Execute(sorgu)

Sheets("sayfa1").Range("C7").CopyFromRecordset rs

sorgu = "select Kod, [Ürün adı],Fiyatı from[Fiyat Listesi$] where fiyatı is null "
Set rs = con.Execute(sorgu)

Sheets("sayfa1").Range("H7").CopyFromRecordset rs

End Sub

Hocam,

Bu şekilde yaptım oldu sorgu = "select Kod, [Ürün adı],[Fiyatı] from[Fiyat Listesi$] where fiyatı = 0 "

 

[YUSUF44]

Aşağıdaki makroyu deneyiniz:

Sub listele()
Set s1 = Sheets("Sayfa1")
Set s2 = Sheets("Stok")
Set s3 = Sheets("Fiyat Listesi")

eski = WorksheetFunction.Max(7, s1.Cells(Rows.Count, "C").End(3).Row, s1.Cells(Rows.Count, "H").End(3).Row)
sonstok = WorksheetFunction.Max(6, s2.Cells(Rows.Count, "C").End(3).Row)
sonfiyat = WorksheetFunction.Max(5, s3.Cells(Rows.Count, "C").End(3).Row)

s1.Range("C7:I" & eski).ClearContents

Set con = VBA.CreateObject("adodb.Connection")

con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
ThisWorkbook.FullName & ";extended properties=""Excel 12.0;hdr=yes"""

sorgu = "select Kod,[Ürün adı],Bakiye " & _
  "from[Stok$C5:I" & sonstok & "] where Bakiye" & "<0"

Set rs = con.Execute(sorgu)
s1.Range("C7").CopyFromRecordset rs

Set con = VBA.CreateObject("adodb.Connection")

con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
ThisWorkbook.FullName & ";extended properties=""Excel 12.0;hdr=yes"""

sorgu = "select Kod,[Ürün adı] " & _
  "from[Fiyat Listesi$C4:F" & sonfiyat & "] where Fiyatı is null"

Set rs = con.Execute(sorgu)
s1.Range("H7").CopyFromRecordset rs

End Sub

Not: Ben sorgu kodlarını düzeltip ayarlayana kadar sayın Erdem_34 halletmiş bile

 

[Erdem Akdemir]

Hocam,

Bu şekilde yaptım oldu sorgu = "select Kod, [Ürün adı],[Fiyatı] from[Fiyat Listesi$] where fiyatı = 0 "

Fiyat kısmı boş ve sıfır yazılı olanların gelmesini istiyorsanız aşağıdaki gibi yapabilirsiniz.

sorgu = "select Kod, [Ürün adı] from[Fiyat Listesi$] where fiyatı is null or fiyatı = 0"

 

[Mehmet Sait]

Aşağıdaki makroyu deneyiniz:

Sub listele()
Set s1 = Sheets("Sayfa1")
Set s2 = Sheets("Stok")
Set s3 = Sheets("Fiyat Listesi")

eski = WorksheetFunction.Max(7, s1.Cells(Rows.Count, "C").End(3).Row, s1.Cells(Rows.Count, "H").End(3).Row)
sonstok = WorksheetFunction.Max(6, s2.Cells(Rows.Count, "C").End(3).Row)
sonfiyat = WorksheetFunction.Max(5, s3.Cells(Rows.Count, "C").End(3).Row)

s1.Range("C7:I" & eski).ClearContents

Set con = VBA.CreateObject("adodb.Connection")

con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
ThisWorkbook.FullName & ";extended properties=""Excel 12.0;hdr=yes"""

sorgu = "select Kod,[Ürün adı],Bakiye " & _
  "from[Stok$C5:I" & sonstok & "] where Bakiye" & "<0"

Set rs = con.Execute(sorgu)
s1.Range("C7").CopyFromRecordset rs

Set con = VBA.CreateObject("adodb.Connection")

con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
ThisWorkbook.FullName & ";extended properties=""Excel 12.0;hdr=yes"""

sorgu = "select Kod,[Ürün adı] " & _
  "from[Fiyat Listesi$C4:F" & sonfiyat & "] where Fiyatı is null"

Set rs = con.Execute(sorgu)
s1.Range("H7").CopyFromRecordset rs

End Sub

Not: Ben sorgu kodlarını düzeltip ayarlayana kadar sayın Erdem_34 halletmiş bile

Teşekkür ederim

 

[Mehmet Sait]

Fiyat kısmı boş ve sıfır yazılı olanların gelmesini istiyorsanız aşağıdaki gibi yapabilirsiniz.

sorgu = "select Kod, [Ürün adı] from[Fiyat Listesi$] where fiyatı is null or fiyatı = 0"

Hocam,

Verdiğiniz kodları tabloma uyarlamak istedim ancak bu hata mesajını veriyor

 

[Erdem Akdemir]

Çalıştığınız dosyayı görmeden bir şey diyemiyorum.

 

[Mehmet Sait]

Çalıştığınız dosyayı görmeden bir şey diyemiyorum.