Listede arayıp bulma ???

[comp_wolf]

iyi günler üstatlar,
yine bir konuda yardımınıza ihtiyacım olacak he zaman ki gibi yardımlarınız ile exel de yapmış olduğum dosyalarımı dahada ileriye taşıyorum sayenizde.
öncelikle çok teşekkür ederim hepinize.

soruma geleyim;

bir exel dosyam var bunun sayfa 1 deki E9 hücresine yazdığım yazıyı sayfa 3 deki AF sütununda arayacak eğer o sütundaki her hangi bir satırda E9 hücresine yazdığım yazı geçiyor ise sayfa 3 AE1 sütununa 2 yazacak yoksa eğer 1 yazacak?

bunu nasıl çözebilirim acil yardımlarınıza ihtiyacım var.

 

[Muzaffer Ali]

Merhaba.
Sayfa1 in kod kısmına aşağıdaki kodları kopyalayın.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("E9")) Is Nothing Then
        If Worksheets("Sayfa3").Range("AF:AF").Find(What:=Target.Text, LookAt:=xlWhole) Is Nothing Then
            Worksheets("Sayfa3").Range("AE1").Value = 1
        Else
            Worksheets("Sayfa3").Range("AE1").Value = 2
        End If
    End If
End Sub

 

[comp_wolf]

Merhaba.
Sayfa1 in kod kısmına aşağıdaki kodları kopyalayın.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("E9")) Is Nothing Then
        If Worksheets("Sayfa3").Range("AF:AF").Find(What:=Target.Text, LookAt:=xlWhole) Is Nothing Then
            Worksheets("Sayfa3").Range("AE1").Value = 1
        Else
            Worksheets("Sayfa3").Range("AE1").Value = 2
        End If
    End If
End Sub

üstadım kod için teşekkür ederim.
kodu dediğin yere koyduğum zaman hata veriyor,
bu satır
Worksheets("Sayfa3").Range("AE1").Value = 1
ve
Worksheets("Sayfa3").Range("AE1").Value = 2
yukarıdaki iki satırda da hata veriyor.
bir düzeltme istesem
Worksheets("Sayfa3").Range("AE1").Value = 2 burada 2 yerine S32 de yazan değeri getirse yoksa 1 olsa üstadım ?

 

[Muzaffer Ali]

Orada hata vermesi normal şartlarda mümkün değil.
Dosyanızı ekleyin inceleyeyim.

 

[comp_wolf]

Orada hata vermesi normal şartlarda mümkün değil.
Dosyanızı ekleyin inceleyeyim.

üstadım hata benden kaynaklanıyormuş kusura bakmayın hallettim. sayfa ismini yanlış girmişim sayfa konuma şifresinide diğer sayfayı eklemişim ondan hata vermiş.
peki ben
Worksheets("Sayfa3").Range("AE1").Value = 2 burada 2 yerine sayfa3 S32 de yazan değeri getirse yoksa sayfa3 T32 olsa üstadım ?
bunu nasıl düzenleyebiliriz peki ???

 

[Muzaffer Ali]

2 yerine Worksheets("Sayfa3").Range("S32").Value
1 yerine Worksheets("Sayfa3").Range("T32").Value yazın.

 

[comp_wolf]

üstat çok teşekkürler kod sayesinde istediğimi yaptım.

 

[comp_wolf]

ben şimdi bu olunca biraz ayrıntıya gitmek istedim ama yine takıldım.

ben
AF1 den AF82 ye kadar bir liste oluşturdum. şimdi o listeden
eğer E9 da yazan AF1 İLE AF41 arasında yazan da arayıp var ise AE1 de yazanı S32 ye yazsın
yok ise devam etsin
bu sefer yine E9 da yazan AF42 ile AF82 arasında yazan da arasın var ise AE41 de yazanı T32 ye yazsın
yine bu listede de yok ise yani AF1 ile AF82 arasında yazan da bulamadı ise bu sefer AE83 de yazanı U32 yazsın
ben aşağıdaki kod ile yapmaya çalıştım ama olmadı yine yardımınız gerekiyor.

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("E9")) Is Nothing Then
Sayfa3.Unprotect "1453"

If Worksheets("FİYATLANDIRMA").Range("AF42:AF82").Find(What:=Target.Text, LookAt:=xlWhole) Is Nothing Then
Worksheets("FİYATLANDIRMA").Range("U32").Value = Worksheets("FİYATLANDIRMA").Range("AE83").Value ' 3. SINIF
Worksheets("FİYATLANDIRMA").Range("S32").Value = ""
Worksheets("FİYATLANDIRMA").Range("T32").Value = ""
Else
Worksheets("FİYATLANDIRMA").Range("T32").Value = Worksheets("FİYATLANDIRMA").Range("AE42").Value ' 2. SINIF
Worksheets("FİYATLANDIRMA").Range("S32").Value = ""
Worksheets("FİYATLANDIRMA").Range("U32").Value = ""
End If

If Worksheets("FİYATLANDIRMA").Range("AF1:AF41").Find(What:=Target.Text, LookAt:=xlWhole) Is Nothing Then
Worksheets("FİYATLANDIRMA").Range("T32").Value = Worksheets("FİYATLANDIRMA").Range("AE42").Value ' 2. SINIF
Worksheets("FİYATLANDIRMA").Range("S32").Value = ""
Worksheets("FİYATLANDIRMA").Range("U32").Value = ""
Else
Worksheets("FİYATLANDIRMA").Range("S32").Value = Worksheets("FİYATLANDIRMA").Range("AE1").Value ' 1. SINIF
Worksheets("FİYATLANDIRMA").Range("T32").Value = ""
Worksheets("FİYATLANDIRMA").Range("U32").Value = ""
End If

Sayfa3.Protect Password:="1453"
End If

End Sub

 

[Muzaffer Ali]

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("E9")) Is Nothing Then
        If Worksheets("Sayfa3").Range("AF1:AF41").Find(What:=Target.Text, LookAt:=xlWhole) Is Nothing Then
            If Worksheets("Sayfa3").Range("AF42:AF82").Find(What:=Target.Text, LookAt:=xlWhole) Is Nothing Then
                Worksheets("Sayfa3").Range("U32").Value = Worksheets("Sayfa3").Range("AE83").Value
            Else
                Worksheets("Sayfa3").Range("T32").Value = Worksheets("Sayfa3").Range("AE41").Value
            End If
        Else
            Worksheets("Sayfa3").Range("S32").Value = Worksheets("Sayfa3").Range("AE1").Value
        End If
    End If
End Sub

 

[comp_wolf]

Üstat emeklerine sağlık çok güzel oldu çok teşekkür ederim yardımların için

 

[comp_wolf]

Merhaba.
Sayfa1 in kod kısmına aşağıdaki kodları kopyalayın.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("E9")) Is Nothing Then
        If Worksheets("Sayfa3").Range("AF:AF").Find(What:=Target.Text, LookAt:=xlWhole) Is Nothing Then
            Worksheets("Sayfa3").Range("AE1").Value = 1
        Else
            Worksheets("Sayfa3").Range("AE1").Value = 2
        End If
    End If
End Sub

Üstat bi konu daha ekleyebilir miyiz yaptığımız işleme acaba ? kusura bakma sonradan kullandıkça bir şeyler daha geliyor o yüzden

şimdi yukarıdaki kodlar tamam
ben o kodlardan bi adım önce
önce sayfa1 E8 e bakacak oradaki rakam 2012 ye eşit ve büyük ise
sayfa 1 H8 de yazan metni AH1 ile AH10 arasında yazan listeden arayacak eğer listede var ise
sayfa2 Q24 e X işareti koyacak yok ise devam edecek
yukarıdaki kodları uygulayacak.

 

[Utekiner]

Merhaba;
Sn. @dalgalikur Bey,
Yazmış olduğunuz kodlar için örnek excel paylaşabilir misiniz. Mümkünse yeni vba başladım. Örnek kodları inceleyerek kendimi geliştirmeye çalışıyorum. Yardımlarınız rica ederim. İyi Çalışmalar.

 

[Muzaffer Ali]

Merhaba;
Sn. @dalgalikur Bey,
Yazmış olduğunuz kodlar için örnek excel paylaşabilir misiniz. Mümkünse yeni vba başladım. Örnek kodları inceleyerek kendimi geliştirmeye çalışıyorum. Yardımlarınız rica ederim. İyi Çalışmalar.

Yeni bir Excel dosyası açın.
Aşağıda bulunan sayfa ismini sağ tıklatın, "Kod Görüntüle" seçin, açılan kod editörüne yukarıda verdiğim kodu kopyalayın.

Yukarıda verdiğim kodları ayrı ayrı deneyiniz ikisini birden kod editörüne kopyalarsanzı hata alırsınız.