• DİKKAT

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

Aranılan Şartı Sağlamayan Sutün verilerini alma

  • Konbuyu başlatan Konbuyu başlatan hmakkiz
  • Başlangıç tarihi Başlangıç tarihi
Katılım
15 Ağustos 2011
Mesajlar
34
Excel Vers. ve Dili
excel
Merhaba,
Tablo içerisinde yer alan iki ayrı sütundaki verilerden istediğimiz şartı sağlamayan verinin sutünunda bulunan tüm verilerle farklı bir sekmeye atmasını istiyorum. Ancak henüz excel konusunda yetersiz olduğumdan başaramadım. Yardımlarınızı bekliyorum. Şimdiden teşekkürler.
 

Ekli dosyalar

Merhaba,

Aşağıdaki kodu boş bir modüle uygulayıp deneyin. Şartları yanlış anladıysam düzenleme yapabiliriz.

Kod:
Option Explicit
 
Sub AKTAR()
    Dim S1 As Worksheet, S2 As Worksheet
    Dim X As Long, Satır As Long, Kontrol As Byte
    
    Set S1 = Sheets("veri girişi")
    Set S2 = Sheets("sonuç")
    Satır = 3
    
    S2.Range("A3:L" & Rows.Count).ClearContents
    
    For X = 2 To S1.Cells(Rows.Count, 1).End(3).Row
        If Not IsError(S1.Cells(X, 3)) Then
            If Not (S1.Cells(X, 3) >= 0.045 And S1.Cells(X, 3) <= 0.055 Or _
                S1.Cells(X, 3) >= 0.015 And S1.Cells(X, 3) <= 0.095 Or _
                S1.Cells(X, 3) >= 0.014 And S1.Cells(X, 3) <= 0.0155 Or _
                S1.Cells(X, 3) = -1) Then
                    Kontrol = 1
            End If
        End If
        
        If Not IsError(S1.Cells(X, 6)) Then
            If Not (S1.Cells(X, 6) >= 0.045 And S1.Cells(X, 6) <= 0.055 Or _
                S1.Cells(X, 6) >= 0.015 And S1.Cells(X, 6) <= 0.095 Or _
                S1.Cells(X, 6) >= 0.014 And S1.Cells(X, 6) <= 0.0155 Or _
                S1.Cells(X, 6) = -1) Then
                    Kontrol = 2
            End If
        End If
        
        If Kontrol = 2 Then
            S1.Rows(X).Copy S2.Rows(Satır)
            Satır = Satır + 1
        End If
    
        Kontrol = 0
    Next
                
    S2.Select
    
    Set S1 = Nothing
    Set S2 = Nothing
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub
 
Çok teşekkür ediyorum korhan..
Ancak bir skıntım daha var çözemedim aralık için verilene formülü bir türlü ayarlayamadım.
Benim istediğim
-1 , 0, 0.045 ile 0.055 arası, 0.1 , 0.14 ile 0.15 arası ve tanımsız(sıfıra bölünmesi ile tanımsız olan) değerler dışında kalan tüm verilerin diğer sayfaya geçmesi.
Bir türlü olmadı. :) başaramadım.
 
Ek olarak aradığım veriler yaklaşık 7-8 bin satırdır, işlem biraz uzun sürecek? kısaltabilirmiyiz
 
Merhaba,

Son eklediğiniz dosyaya göre hangi sütunlar bu sorguya tabi tutulacak?
 
Merhaba,

Şimdi durumu biraz daha açık yazayım ekte göndermiş olduğum "veri girişi" sekmesinde yer alan verileri günlük alıyorum.

İlk olarak

N Sütunu / K Sütunu yapıyorum istemiş olduğum şartları sağlayıp sağlamadığına bakıyorum.
Doğru olan satış verileri
N/K oranı : tanımsız(sayı/0) , -1 , 0 , 0.045 ile 0.055 arası, 0.14 ile 0.15 arasında olan değerlerdir.
Eğer bu değerler dışında bir satır ile karşılaşırsam o satırda ki D,E,G,H,I,J,K,M,N,S sütunlarını "Tutanak" Sekmenine alıyorum.

Aynı şekilde

M Sütunu / S Sütunu yapıyorum istemiş olduğum şartları sağlayıp sağlamadığına bakıyorum.
Doğru olan satış verileri
M/S oranı : tanımsız(sayı/0) , -1 , 0 , 0.045 ile 0.055 arası, 0.14 ile 0.15 arasında olan değerlerdir.
Eğer bu değerler dışında bir satır ile karşılaşırsam o satırda ki D,E,G,H,I,J,K,M,N,S sütunlarını "Tutanak" Sekmenine alıyorum.

Benim isteğim bu işlemleri benim yerime yapacak bir formül :)

Not: Ekte verdiğim tabloda sarı boyalılar "tutanak" sekmesine taşımak istediğim aradığım, aradığım özel şartlara uymayan verilerdir.
 

Ekli dosyalar

Merhaba,

Aşağıdaki kodu denermisiniz.

Kod:
Sub AKTAR()
    Dim S1 As Worksheet, S2 As Worksheet
    Dim X As Long, Satır As Long, Kontrol As Byte
    Dim Veri
    
    Set S1 = Sheets("Veri Girişi")
    Set S2 = Sheets("Tutanak")
    Satır = 25
    
    S2.Range("A25:J" & Rows.Count).ClearContents
    
    For X = 2 To S1.Cells(Rows.Count, 1).End(3).Row
        On Error Resume Next
        Veri = S1.Cells(X, "N") / S1.Cells(X, "K")
        On Error GoTo 0
        
        If S1.Cells(X, "N") <> 0 And S1.Cells(X, "K") = 0 Then
            Kontrol = 1
        ElseIf Veri >= 0.045 And Veri <= 0.055 Then
            Kontrol = 1
        ElseIf Veri >= 0.015 And Veri <= 0.095 Then
            Kontrol = 1
        ElseIf Veri >= 0.014 And Veri <= 0.0155 Then
            Kontrol = 1
        ElseIf Veri = -1 Then
            Kontrol = 1
        End If
        
        On Error Resume Next
        Veri = S1.Cells(X, "M") / S1.Cells(X, "S")
        On Error GoTo 0
        
        If S1.Cells(X, "M") <> 0 And S1.Cells(X, "S") = 0 Then
            Kontrol = 1
        ElseIf Veri >= 0.045 And Veri <= 0.055 Then
            Kontrol = 1
        ElseIf Veri >= 0.015 And Veri <= 0.095 Then
            Kontrol = 1
        ElseIf Veri >= 0.014 And Veri <= 0.0155 Then
            Kontrol = 1
        ElseIf Veri = -1 Then
            Kontrol = 1
        End If
        
        If Kontrol <> 1 Then
            S2.Cells(Satır, 1) = S1.Cells(X, "D")
            S2.Cells(Satır, 2) = S1.Cells(X, "E")
            S2.Cells(Satır, 3) = S1.Cells(X, "G")
            S2.Cells(Satır, 4) = S1.Cells(X, "H")
            S2.Cells(Satır, 5) = S1.Cells(X, "I")
            S2.Cells(Satır, 6) = S1.Cells(X, "J")
            S2.Cells(Satır, 7) = S1.Cells(X, "K")
            S2.Cells(Satır, 8) = S1.Cells(X, "M")
            S2.Cells(Satır, 9) = S1.Cells(X, "N")
            S2.Cells(Satır, 10) = S1.Cells(X, "S")
            Satır = Satır + 1
        End If
    
        Kontrol = 0
    Next
                
    S2.Select
    
    Set S1 = Nothing
    Set S2 = Nothing
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub
 
Merhaba,

Öncelikle sabrınız ve yardımlarınız için çok teşekkür ediyorum.
aranılan değerlerle ile ilgili bir problem oluşuyor. istemediğim veriler geçiyo "tutanak" sekmesine.
Aşağıda sayı doğrusu verdim bu doğruda kırmızı ile taralı ve işaretli yerler doğru değerlerdir yani diğer sekmeye geçmeyecek.
Kırmızı taralı ve işaretli yerler dışında kalan tüm sayıları almak istiyorum.

 
Merhaba,

Sorunuzu daha doğru anlamak adına istediğiniz işlem aşağıdkai gibimidir.

(n/k) ve (m/s) bölme işlemi uygulanacak.
İşlem sonunda tanımsız(sayı/0) , -1 , 0 , 0.045 ile 0.055 arası, 0.14 ile 0.15 arasında olan değerler oluşmuyorsa bu satır diğer sayfaya aktarılacak.


Eğer doğru anlamışsam aktarım için her satırda her iki işlemin gerçekleşmesi gerekiyormu? Yoksa tek işlemin sonucu oluştuğunda bu satırın aktarılması için yeterlimidir?
 
(n/k) ve (m/s) bölme işlemi uygulanacak.
İşlem sonunda tanımsız(sayı/0) , -1 , 0 , 0.045 ile 0.055 arası, 0,095 ile 0,105 arası, 0.14 ile 0.15 arasında olan değerler oluşmuyorsa bu satır diğer sayfaya aktarılacak.

Aktarım için sadece bir tanesi yeterli
 
Merhaba,

Son eklediğiniz dosyada belirttiğiniz koşulları formülüze ederek yandaki sütunlarda değerlendirdim.

U-V sütunlarında bölme işlemleri var.
W-X sütunlarında koşullarınızı sorgulayan formüller var. Koşullar sağlanıyorsa aktarılmayacak değerlere "X" ifadesi yazdırılıyor.
Bu durumda sizin sarı renkle işaretlemiş olduğunuz satırlarda aktarılmayacak değerler arasında görünüyor.

Eğer yanlış yorumlamıyorsam burada bir çelişki yok mu?

Uygulamalı dosya ektedir.
 

Ekli dosyalar

Merhaba,

İzah edeyim,
Oranlardan herhangi biri sağlamıyorsa diğer sekmeye atmalıdır. Yani vermiş olduğunuz örnek dosyada hem W hemde X sütunlarını her ikisinde "X" ifadesi yer alıyorsa diğer sekmeye alınmayacaktır.
Ek olarak 10 ve 11 satırlarda,
V sütununda elde edilen oran -1 dir ve bu değer aranılan doğru bir değerdir yani diğer sekmeye alınmayacaktır. Sizin hazırladığınız koşullara göre "X" ifadesi yer almıyor orada bir hata var.
 
Merhaba,

İzah edeyim,
Oranlardan herhangi biri sağlamıyorsa diğer sekmeye atmalıdır. Yani vermiş olduğunuz örnek dosyada hem W hemde X sütunlarını her ikisinde "X" ifadesi yer alıyorsa diğer sekmeye alınmayacaktır.
Ek olarak 10 ve 11 satırlarda,
V sütununda elde edilen oran -1 dir ve bu değer aranılan doğru bir değerdir yani diğer sekmeye alınmayacaktır. Sizin hazırladığınız koşullara göre "X" ifadesi yer almıyor orada bir hata var.

.................................
 
Merhaba,

V10 hücresindeki değer görüntü olarak -1 gibi görünüyor fakat gerçekte değer -0,999999999999999 olarak hesaplanıyor. Formüldede koşul direk -1 sorgulaması yaptığı için iki değer birbirine eşit olmadığından bu hücre diğer sekmeye aktarılacakmış gibi görünüyor. Size net bir cevap verebilmem için bu konuları netleştirmeniz gerekiyor.

Önceki mesajınızda eklediğiniz resime göre bölme işlemi sonuçların ondalık hanelerini 3 karakter olacak şekilde yuvarlama yaparsak sanki sorun ortadan kalkacakmış gibi görünüyor.

Ayrıca son mesajınızdan anladığım kadarıyla W-X sütunlarından birisi koşulu sağlamıyorsa yani boşsa diğer sekmeye aktarılacak. Eğer iki sütunda da X ifadesi varsa aktarılmayacak.
 
Merhaba Üstad,

Söylediğiniz gibi virgülden sonra 3 hane alarak yuvarlamak sorunumuzu çözecektir.

Aşağıda verdiğim sayı doğrusunda virgülden sonra üç basamak şeklinde yuvarladığımızda sonucumuzu elde etmiş oluyoruz.



Söylediğiniz gibi W-X sütunlarından birisi koşulu sağlamıyorsa yani boşsa diğer sekmeye aktarılacak. Eğer iki sütunda da X ifadesi varsa aktarılmayacak.

Not: Verdiğiniz örnek tabloda aktarılmayacak değerler "X" ile ifade edilirken, aktarılmayacak değerlen biri olan tanımsız değer yani Sayı/sıfır oluşan tanımsız değer "#SAYI/0!" "X" ifadesini almamaktadır. Bu durum sorun oluşturmaz umarım.
 
Son düzenleme:
Merhaba,

Aşağıdaki kodu denermisiniz.

10.000 satır veride denedim. Bende 5 saniye kadar sürüyor.

Kod:
Sub AKTAR()
    Dim S1 As Worksheet, S2 As Worksheet
    Dim X As Long, Satır As Long
    Dim Kontrol_1 As Byte, Kontrol_2 As Byte
    Dim Veri, WF As WorksheetFunction
    
    Set S1 = Sheets("Veri Girişi")
    Set S2 = Sheets("Tutanak")
    Set WF = WorksheetFunction
    Satır = 25
    
    S2.Range("A25:J" & Rows.Count).ClearContents
    
    For X = 2 To S1.Cells(Rows.Count, 1).End(3).Row
        On Error Resume Next
        Veri = WF.Round(S1.Cells(X, "N") / S1.Cells(X, "K"), 3)
        On Error GoTo 0
        
        If S1.Cells(X, "N") <> 0 And S1.Cells(X, "K") = 0 Then
            Kontrol_1 = 1
        ElseIf Veri >= 0.045 And Veri <= 0.055 Then
            Kontrol_1 = 1
        ElseIf Veri >= 0.095 And Veri <= 0.105 Then
            Kontrol_1 = 1
        ElseIf Veri >= 0.14 And Veri <= 0.155 Then
            Kontrol_1 = 1
        ElseIf Veri = -1 Then
            Kontrol_1 = 1
        ElseIf Veri = 0 Then
            Kontrol_1 = 1
        End If
        
        On Error Resume Next
        Veri = WF.Round(S1.Cells(X, "M") / S1.Cells(X, "S"), 3)
        On Error GoTo 0
        
        If S1.Cells(X, "M") <> 0 And S1.Cells(X, "S") = 0 Then
            Kontrol_2 = 1
        ElseIf Veri >= 0.045 And Veri <= 0.055 Then
            Kontrol_2 = 1
        ElseIf Veri >= 0.095 And Veri <= 0.105 Then
            Kontrol_2 = 1
        ElseIf Veri >= 0.14 And Veri <= 0.155 Then
            Kontrol_2 = 1
        ElseIf Veri = -1 Then
            Kontrol_2 = 1
        ElseIf Veri = 0 Then
            Kontrol_2 = 1
        End If
        
        If Kontrol_1 <> 1 Or Kontrol_2 <> 1 Then
            S2.Cells(Satır, 1) = S1.Cells(X, "D")
            S2.Cells(Satır, 2) = S1.Cells(X, "E")
            S2.Cells(Satır, 3) = S1.Cells(X, "G")
            S2.Cells(Satır, 4) = S1.Cells(X, "H")
            S2.Cells(Satır, 5) = S1.Cells(X, "I")
            S2.Cells(Satır, 6) = S1.Cells(X, "J")
            S2.Cells(Satır, 7) = S1.Cells(X, "K")
            S2.Cells(Satır, 8) = S1.Cells(X, "M")
            S2.Cells(Satır, 9) = S1.Cells(X, "N")
            S2.Cells(Satır, 10) = S1.Cells(X, "S")
            Satır = Satır + 1
        End If
    
        Kontrol_1 = 0: Kontrol_2 = 0
    Next
                
    S2.Select
    
    Set S1 = Nothing
    Set S2 = Nothing
    Set WF = Nothing
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub
 
Merhaba Korhan bey,

Öncelikle size çok çok teşekkür ediyorum. Gerçekten yardımlarınız sayesinde zamandan tasarruf etmeyi başarıyoruz :) çok sağolun.

Hazırlanan bu format üzerinde herhangi bir sütun verisin içeriğine göre formul yapmak mümkün mü ?
Mesala, sizin mesajınızda ki "ÖRNEK.xlsm" formatta H sutununda ki veri "peşin satış" sa formul farklı "taksitli ise farklı gibi
 
Geri
Üst