HÜCREDE YAZAN SAYILAR ARASINI FİLTRELEME

[furmet]

Merhaba Arkadaşlar

Formunda verilerim var sürekli olarak güncellenen. Yeni yapacağım sayfaya tasarımı ile G1 satırına yazdığım satırdan büyük değerleri A sütununa B sütununa yazdığım sayılardan düşük değerleri B sütununa filtrelemek istiyorum. Nasıl yapabilirim ?

 

[YUSUF44]

Lütfen örnek excel dosyası paylaşın ve profilinizde kullandığınız excel versiyonunu belirtin ki ona göre çözüm önerilebilsin.

 

[furmet]

Lütfen örnek excel dosyası paylaşın ve profilinizde kullandığınız excel versiyonunu belirtin ki ona göre çözüm önerilebilsin.

Merhaba Yusuf Bey,

Dosya linkte yer almaktadır.

İndir BORU ÖLÇÜ STANDARTLARI

Dosyayı indir BORU ÖLÇÜ STANDARTLARI

dosya.co

 

[YUSUF44]

Affınıza sığınıyorum, Excel'in solidworks diye bir versiyonu var mı? Yoksa microsoft ofisten başka bir program mı kullanıyorsunuz?

 

[YUSUF44]

Excel'de ADO SQL sorgusuyla hazırlanmış aşağıdaki makroyu deneyiniz:

Sub aktar()
Set s1 = Sheets("Sayfa1")
Set s2 = Sheets("Sayfa2")
son = WorksheetFunction.Max(2, s1.Cells(Rows.Count, "C").End(3).Row)
eski = WorksheetFunction.Max(s2.Cells(Rows.Count, "A").End(3).Row, s2.Cells(Rows.Count, "B").End(3).Row)
If eski > 2 Then s2.Range("A3:C" & 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 [DIŞÇAP (mm)] from [Sayfa1$] where [DIŞÇAP (mm)]>" & s2.[F1]
Set rs = con.Execute(sorgu)

s2.[A3].CopyFromRecordset rs

sorgu = "select [İÇ ÇAP  (mm)] from [Sayfa1$] where [İÇ ÇAP  (mm)]<" & s2.[F2]
Set rs = con.Execute(sorgu)

s2.[B3].CopyFromRecordset rs

enson = WorksheetFunction.Max(s2.Cells(Rows.Count, "A").End(3).Row, s2.Cells(Rows.Count, "B").End(3).Row)
s2.Range("C3:C" & enson).FormulaR1C1 = "=(RC[-2]-R1C6)+(R2C6-RC[-1])"
End Sub

 

[furmet]

Excel'de ADO SQL sorgusuyla hazırlanmış aşağıdaki makroyu deneyiniz:

Sub aktar()
Set s1 = Sheets("Sayfa1")
Set s2 = Sheets("Sayfa2")
son = WorksheetFunction.Max(2, s1.Cells(Rows.Count, "C").End(3).Row)
eski = WorksheetFunction.Max(s2.Cells(Rows.Count, "A").End(3).Row, s2.Cells(Rows.Count, "B").End(3).Row)
If eski > 2 Then s2.Range("A3:C" & 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 [DIŞÇAP (mm)] from [Sayfa1$] where [DIŞÇAP (mm)]>" & s2.[F1]
Set rs = con.Execute(sorgu)

s2.[A3].CopyFromRecordset rs

sorgu = "select [İÇ ÇAP  (mm)] from [Sayfa1$] where [İÇ ÇAP  (mm)]<" & s2.[F2]
Set rs = con.Execute(sorgu)

s2.[B3].CopyFromRecordset rs

enson = WorksheetFunction.Max(s2.Cells(Rows.Count, "A").End(3).Row, s2.Cells(Rows.Count, "B").End(3).Row)
s2.Range("C3:C" & enson).FormulaR1C1 = "=(RC[-2]-R1C6)+(R2C6-RC[-1])"
End Sub

Emeğinize sağlık teşekkür ederim fakat sistem içerisine makroyu eklediğim zaman,

"Set rs = con.Execute(sorgu)" Satırında Sistem Hata veriyor

 

[furmet]

S

Affınıza sığınıyorum, Excel'in solidworks diye bir versiyonu var mı? Yoksa microsoft ofisten başka bir program mı kullanıyorsunuz?

Makine Mühendisi olarak Çalışıyorum. 3 Boyutlu taasarım programı olarak kulladığımız programın adı Solidworks. Eğer bu alanda çalışan arkadaşlar varsa daha kolay irtibat kurabilmek için böyle bir ekleme yaptım Excel versiyonu değil

 

[YUSUF44]

Hatırlatmayı unuttum, Sayfa1'de C1 ve D1'de bulunan noktaları silin. Kodda yazdığı gibi olsun başlıklar. SQL sorgusu noktayı sevmiyor.

 

[furmet]

Hatırlatmayı unuttum, Sayfa1'de C1 ve D1'de bulunan noktaları silin. Kodda yazdığı gibi olsun başlıklar. SQL sorgusu noktayı sevmiyor.

Şimdi sistem verimli bir şekilde çalıştı çok teşekkür ederim

 

[YUSUF44]

Yanız ben kodu her iki sütun ayrı ayrı değerlendirilecek şeklinde düşünerek hazırladım. Eğer her iki şarta da aynı anda uyan veriler isteniyorsa kodun değişmesi gerekir.

 

[furmet]

Yanız ben kodu her iki sütun ayrı ayrı değerlendirilecek şeklinde düşünerek hazırladım. Eğer her iki şarta da aynı anda uyan veriler isteniyorsa kodun değişmesi gerekir.

Şimdi bende onu test ettim hata verdi diye iletiyordum iki satır birbirleri ile bağlantılı ayrı ayrı çalışıyor sistem söylediğiniz gibi

 

[YUSUF44]

Şöyle olur o zaman:

Sub aktar()
Set s1 = Sheets("Sayfa1")
Set s2 = Sheets("Sayfa2")
son = WorksheetFunction.Max(2, s1.Cells(Rows.Count, "C").End(3).Row)
eski = WorksheetFunction.Max(s2.Cells(Rows.Count, "A").End(3).Row, s2.Cells(Rows.Count, "B").End(3).Row)
If eski > 2 Then s2.Range("A3:C" & 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 [DIŞÇAP (mm)],[İÇ ÇAP  (mm)] from [Sayfa1$] where [DIŞÇAP (mm)]>" & s2.[F1] & " and [İÇ ÇAP  (mm)]<" _
        & s2.[F2] '& " and [DIŞÇAP (mm)] is not null and [İÇ ÇAP  (mm)] is not null"
Set rs = con.Execute(sorgu)

s2.[A3].CopyFromRecordset rs

enson = WorksheetFunction.Max(s2.Cells(Rows.Count, "A").End(3).Row, s2.Cells(Rows.Count, "B").End(3).Row)
s2.Range("C3:C" & enson).FormulaR1C1 = "=(RC[-2]-R1C6)+(R2C6-RC[-1])"
End Sub

 

[furmet]

Şimdi ço

Şöyle olur o zaman:

Sub aktar()
Set s1 = Sheets("Sayfa1")
Set s2 = Sheets("Sayfa2")
son = WorksheetFunction.Max(2, s1.Cells(Rows.Count, "C").End(3).Row)
eski = WorksheetFunction.Max(s2.Cells(Rows.Count, "A").End(3).Row, s2.Cells(Rows.Count, "B").End(3).Row)
If eski > 2 Then s2.Range("A3:C" & 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 [DIŞÇAP (mm)],[İÇ ÇAP  (mm)] from [Sayfa1$] where [DIŞÇAP (mm)]>" & s2.[F1] & " and [İÇ ÇAP  (mm)]<" _
        & s2.[F2] '& " and [DIŞÇAP (mm)] is not null and [İÇ ÇAP  (mm)] is not null"
Set rs = con.Execute(sorgu)

s2.[A3].CopyFromRecordset rs

enson = WorksheetFunction.Max(s2.Cells(Rows.Count, "A").End(3).Row, s2.Cells(Rows.Count, "B").End(3).Row)
s2.Range("C3:C" & enson).FormulaR1C1 = "=(RC[-2]-R1C6)+(R2C6-RC[-1])"
End Sub

Şimdi çok verimli bir şekilde çalışıyor emeğinize sağlık çok teşekkür ederim bir çok mühendis arkadaşımızın işine yarayacak bir uygulama oldu sağolun

 

[YUSUF44]

Bundan sonraki sorularınızda örnek dosa paylaşımına önem verip isteğiniz tam olarak açıklamanız (anlattıklarınız bizim anladığımız kadar geçerli oluyor sonuçta, siz ne anlatmak istediğinizi biliyor ve yazdıklarınızı da anlıyor olabilirsiniz ama biz dosyanıza ve yapmak istediğinize hakim olmadığımız için anlamakta zorlanabiliriz) çözüme ulaşmanızı hızlandıracak ve gereksiz mesajlaşmaları önleyecektir. Bu konuda tecrübe etmiş olduk

 

[furmet]

Bundan sonraki sorularınızda örnek dosa paylaşımına önem verip isteğiniz tam olarak açıklamanız (anlattıklarınız bizim anladığımız kadar geçerli oluyor sonuçta, siz ne anlatmak istediğinizi biliyor ve yazdıklarınızı da anlıyor olabilirsiniz ama biz dosyanıza ve yapmak istediğinize hakim olmadığımız için anlamakta zorlanabiliriz) çözüme ulaşmanızı hızlandıracak ve gereksiz mesajlaşmaları önleyecektir. Bu konuda tecrübe etmiş olduk

Daha dikkatli olacağım teşekkür ederim