• DİKKAT

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

Tablo yardımı

M

Mehmet Sait

Altın Üye
Katılım
19 Ekim 2009
Mesajlar
840
Excel Vers. ve Dili
Office 2016 TR
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.
 

Ekli dosyalar

Merhaba,

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

Kod: 
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
 

Ekli dosyalar

Erdem_34' Alıntı:
Merhaba,

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

Kod: 
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
Genişletmek için tıkla ...

Yardımlarınız için teşekkür ederim
 
Erdem_34' Alıntı:
Merhaba,

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

Kod: 
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
Genişletmek için tıkla ...

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
 
Erdem_34' Alıntı:
Merhaba,

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

Kod: 
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
Genişletmek için tıkla ...

Hocam,

Bu şekilde yaptım oldu sorgu = "select Kod, [Ürün adı],[Fiyatı] from[Fiyat Listesi$] where fiyatı = 0 "
 
Aşağıdaki makroyu deneyiniz:

PHP: 
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 :)
 
Son düzenleme:
Dunya_' Alıntı:
Hocam,

Bu şekilde yaptım oldu sorgu = "select Kod, [Ürün adı],[Fiyatı] from[Fiyat Listesi$] where fiyatı = 0 "
Genişletmek için tıkla ...

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

Kod: 
sorgu = "select Kod, [Ürün adı] from[Fiyat Listesi$] where fiyatı is null or fiyatı = 0"
 
YUSUF44' Alıntı:
Aşağıdaki makroyu deneyiniz:

PHP: 
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 :)
Genişletmek için tıkla ...

Teşekkür ederim :)
 
Erdem_34' Alıntı:
Fiyat kısmı boş ve sıfır yazılı olanların gelmesini istiyorsanız aşağıdaki gibi yapabilirsiniz.

Kod: 
sorgu = "select Kod, [Ürün adı] from[Fiyat Listesi$] where fiyatı is null or fiyatı = 0"
Genişletmek için tıkla ...

Hocam,

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

Ekli dosyalar

  • Adsız.png
    Adsız.png
    3.5 KB · Görüntüleme: 4
Çalıştığınız dosyayı görmeden bir şey diyemiyorum.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst