• DİKKAT

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

HÜCREDE YAZAN SAYILAR ARASINI FİLTRELEME

F

furmet

Katılım
21 Temmuz 2017
Mesajlar
59
Excel Vers. ve Dili
Solidworks Office 2019
Merhaba Arkadaşlar

lflqh98.png


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 ?

knguunl.png
 
Lütfen örnek excel dosyası paylaşın ve profilinizde kullandığınız excel versiyonunu belirtin ki ona göre çözüm önerilebilsin.
 
Affınıza sığınıyorum, Excel'in solidworks diye bir versiyonu var mı? Yoksa microsoft ofisten başka bir program mı kullanıyorsunuz?
 
Excel'de ADO SQL sorgusuyla hazırlanmış aşağıdaki makroyu deneyiniz:

PHP: 
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
 
YUSUF44' Alıntı:
Excel'de ADO SQL sorgusuyla hazırlanmış aşağıdaki makroyu deneyiniz:

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

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
 
S
YUSUF44' Alıntı:
Affınıza sığınıyorum, Excel'in solidworks diye bir versiyonu var mı? Yoksa microsoft ofisten başka bir program mı kullanıyorsunuz?
Genişletmek için tıkla ...

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
 
Hatırlatmayı unuttum, Sayfa1'de C1 ve D1'de bulunan noktaları silin. Kodda yazdığı gibi olsun başlıklar. SQL sorgusu noktayı sevmiyor.
 
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.
 
YUSUF44' Alıntı:
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.
Genişletmek için tıkla ...
Ş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
 
Şöyle olur o zaman:

PHP: 
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 ço
YUSUF44' Alıntı:
Şöyle olur o zaman:

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

Daha dikkatli olacağım teşekkür ederim
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst