koşullu hücre arama

[aykut12344]

İstediğim ; A:A sütununda tüm sutunun hücrelerine bakarak soldan ilk 5 harf olarak alıp ahmet yazısını gördüğü satırdaki G hücresindeki Değerden D hücresindeki değeri çıkarıp B hücresine yazdırmasını istiyorum.
Not: Sadece ahmet aratmayacağım mesela A sütununda ali'yi aratıp alinin yanındaki hücreye bir üstte anlattığım işlemin aynısını yapmasını istiyorum.
Öneri: A1 hücresine kelimeyi B1 hücresine de soldan sayarak ilk kaç harfe bakacağını yazıp düğmeye bastığımda sonuçları elde edeyim.

Ekteki excelde yukarıda istediklerimi uygulanabilecek veriler ve yine aynı şekilde altında aynı açıklamalar mevcut. Şimdiden Teşekkürler.

 

[Murat OSMA]

İnceleyiniz; http://www.excel.web.tr/f53/forum-da-soruyu-ekli-dosyaya-yazmak-t133816.html#post725365

 

[aykut12344]

arkadaslar konuyla ilgili yardim edebilecek yok mu :/

 

[Korhan Ayhan]

Aşağıdaki kodu deneyiniz.

Sub ARA_LISTELE()
    Dim X As Long, Veri As String, Aranan As String
    
    Range("B2:B" & Rows.Count).ClearContents

    For X = 2 To Cells(Rows.Count, 1).End(3).Row
        Veri = UCase(Replace(Replace(Cells(X, "A"), "ı", "I"), "i", "İ"))
        Aranan = UCase(Replace(Replace(Range("A1"), "ı", "I"), "i", "İ"))

        If Left(Veri, Range("B1")) = Aranan Then
            Cells(X, "B") = Cells(X, "G") - Cells(X, "D")
        End If
    Next
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[Murat OSMA]

Sayfa1'in kod kısmına şu kodları yazıp deneyiniz;

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim evn As Range
    Dim a As Variant
    If Target.Address(0, 0) <> "A1" Then Exit Sub
        Range("B2:B16").ClearContents
        Set evn = Range("A2:A16").Find(Range("A1").Value, , , 2)
        If Not evn Is Nothing Then
            a = evn.Address
            Do
                Set evn = Range("A2:A16").FindNext(evn)
                evn.Offset(0, 1).Value = evn.Offset(0, 6).Value - evn.Offset(0, 3).Value
            Loop Until a = evn.Address
        End If
    a = Empty: Set evn = Nothing
End Sub

B1 hücresine gerek yok, sadece A1 hücresine yazarak arama yapın.

 

[Murat OSMA]

Korhan Bey, soruya cevap verdikten sonra mesajınızı gördüm.

Bilginize...

Saygılar,

 

[aykut12344]

Aşağıdaki kodu deneyiniz.

Sub ARA_LISTELE()
    Dim X As Long, Veri As String, Aranan As String
    
    Range("B2:B" & Rows.Count).ClearContents

    For X = 2 To Cells(Rows.Count, 1).End(3).Row
        Veri = UCase(Replace(Replace(Cells(X, "A"), "ı", "I"), "i", "İ"))
        Aranan = UCase(Replace(Replace(Range("A1"), "ı", "I"), "i", "İ"))

        If Left(Veri, Range("B1")) = Aranan Then
            Cells(X, "B") = Cells(X, "G") - Cells(X, "D")
        End If
    Next
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

Korhan Bey ; Şu anki macro sadece A sütununda belirli aralıklarda çalışıyor A2 ile A16 arasında bunu A sütunun tamamında yaptırmak istiyorum çünkü çalıştığım data dosyasında A sütununda çok fazla veri var Yardımcı olabilir misiniz

 

[aykut12344]

arkadaşlar tekrarlıyorum yazdığımı ama konu hakkında yardımcı olabilecek var mı ?

Sorun: A sütunun da sadece belirli aralığa bakıyor oysa bende 300 binden fazla veri yazılı A sütununda Aynı şekilde D ve G sütunu için geçerli

 

[Korhan Ayhan]

Merhaba,

Önerdiğim kod "A" sütunundaki en son satırdan yukarıya doğru son dolu satırı tespit edip işleme başlıyor. Doğal olarak belirttiğiniz aralıkta ne kadar veri varsa taraması gerekiyor. İlk satırda kriterleriniz olduğu için döngüyü 2. satırdan itibaren başlattım. Bunun dışında kod içinde bir sınırlama yoktur. Kaç satır veriniz varsa işleme alması gerekir.

 

[aykut12344]

Merhaba,

Önerdiğim kod "A" sütunundaki en son satırdan yukarıya doğru son dolu satırı tespit edip işleme başlıyor. Doğal olarak belirttiğiniz aralıkta ne kadar veri varsa taraması gerekiyor. İlk satırda kriterleriniz olduğu için döngüyü 2. satırdan itibaren başlattım. Bunun dışında kod içinde bir sınırlama yoktur. Kaç satır veriniz varsa işleme alması gerekir.

Korhan bey sizin yazdığınız kodu excelde aynen koyuyorum ancak A1 hücresine istediğim arama kelimesini yazdığımda herhangi bir algılama yapmıyor yani kod çalışmıyor diğer arkadaşın yazdığı da belirli bir aralık olduğu için bu şekilde belirttim.

 

[Korhan Ayhan]

Önerdiğim kodu bir modüle uygulamanız gerekir. A1 hücresine giriş yaparak çalışan bir kod değildir. Butona tanımlamanız gerekir.

 

[aykut12344]

Korhan Bey modüle olarak nasıl tanımlayacağımı bilmiyorum yardımcı olabilme şansınız var mıdır ? Ayrıca sizin cevabınızın altına bir arkadaş da bir kod yazmış o kod başarılı bir şekilde çalışıyor sadece A sütununda eklediğim dosyayı düşünerek aldığı için a2 a16 arasını almış ondan bi düzenleme yapmanız mümkün mü

 

[Korhan Ayhan]

Dosyanızı açın.
Alt+F11 tuşlarına basın.
Karşınıza kod editörü gelecektir.
INSERT menüsünden MODULE seçeneğini seçin.
Sağ tarafta açılan beyaz alana kodu uygulayın.

Son olarak excel sayfanıza dönüp sayfaya bir buton ekleyin. Butona sağ klik yapın ve MARO ATA seçeneği ile makroyu butona tanımlayın.

Bundan sonra A1 hücresine veri girip butona tıklayın.

Hücre değişiminde kodun çalışmasını istiyorsanız aşağıdaki kodu deneyebilirsiniz.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("A1")) Is Nothing Then Exit Sub
    Range("B2:B" & Rows.Count).ClearContents
    If Target = "" Then Exit Sub
    Set BUL = Range("A2:A" & Rows.Count).Find(Target & "*")
    If Not BUL Is Nothing Then
        ADRES = BUL.Address
        Do
            Cells(BUL.Row, "B") = Cells(BUL.Row, "G") - Cells(BUL.Row, "D")
            Set BUL = Range("A2:A" & Rows.Count).FindNext(BUL)
        Loop While Not BUL Is Nothing And BUL.Address <> ADRES
    End If
    MsgBox "Arama işlemi tamamlanmıştır.", vbInformation
End Sub