Döngü

[cevatyildiz]

Merhaba Arkadaşlar,

Aşağıdaki işlem A sütununa tıklandıgında ilgili satır için çalışıyor. Bir döngü ile beraber dolu olan tüm satırlar için çalışmasın sağlayabilir misiniz?

Tesekkurler, iyi calismalar

Aşağıdaki

Private Sub Worksheet_Change(ByVal Target As Range)

Dim s1, s2
Dim i, b, s, c, p, q

If Intersect(Target, Range("a3:a50000")) Is Nothing Then Exit Sub
Set s1 = Sheets("Sonuc")
Set s2 = Sheets("Bilgici")

q = s1.Cells(Target.Row, "c").Value * 1
b = s1.Cells(Target.Row, "e").Value
s = s1.Cells(Target.Row, "f").Value
c = s1.Cells(Target.Row, "g").Value
p = s1.Cells(Target.Row, "h").Value


s1.Cells(Target.Row, "aa").Value = Null

For i = 2 To s2.Cells(65536, "a").End(xlUp).Row
If q = s2.Cells(i, "g").Value And b = s2.Cells(i, "m").Value And s = s2.Cells(i, "n").Value And c = s2.Cells(i, "o").Value And p = s2.Cells(i, "q").Value Then

    s1.Cells(Target.Row, "aa").Value = s2.Cells(i, "d").Value
    s1.Cells(Target.Row, "ab").Value = s2.Cells(i, "s").Value
    s1.Cells(Target.Row, "aq").Value = s2.Cells(i, "e").Value

End If
Next i
Set s1 = Nothing
Set s2 = Nothing

End Sub

 

[Hakan ERDOST]

Range("a3:a50000")

Başvuru aralığını değiştirin. Örneğin;

Range("a3:ac50000")

şeklinde.Örnek dosya eklerseniz yardımcı olan çıkacaktır.

 

[cevatyildiz]

Aslında kodlama ile ilgili bilgim yok. Sadece bir döngü oluşturmak istiyorum. Şu an kodun çalışması için her satırda her defasında A hücresine tıklamam gerekiyor. Ben bir defa A hücresine tıklayıp kodun her satır için çalışmasını istiyorum.

 

[cevatyildiz]

Yardımcı olabilirseniz sevinirim...

 

[ridvanucok]

Merhaba,

Aşağıdaki gibi dener misin? A sütunu ile AA sütunları arası işlem yapar.

Private Sub Worksheet_Change(ByVal Target As Range)

Dim s1, s2
Dim i, b, s, c, p, q

If Intersect(Target, Range("A3:AA50000")) Is Nothing Then Exit Sub
Set s1 = Sheets("Sonuc")
Set s2 = Sheets("Bilgici")

q = s1.Cells(Target.Row, "c").Value * 1
b = s1.Cells(Target.Row, "e").Value
s = s1.Cells(Target.Row, "f").Value
c = s1.Cells(Target.Row, "g").Value
p = s1.Cells(Target.Row, "h").Value


s1.Cells(Target.Row, "aa").Value = Null

For i = 2 To s2.Cells(65536, "a").End(xlUp).Row
If q = s2.Cells(i, "g").Value And b = s2.Cells(i, "m").Value And s = s2.Cells(i, "n").Value And c = s2.Cells(i, "o").Value And p = s2.Cells(i, "q").Value Then

s1.Cells(Target.Row, "aa").Value = s2.Cells(i, "d").Value
s1.Cells(Target.Row, "ab").Value = s2.Cells(i, "s").Value
s1.Cells(Target.Row, "aq").Value = s2.Cells(i, "e").Value

End If
Next i
Set s1 = Nothing
Set s2 = Nothing

End Sub

Yardımcı olabilirseniz sevinirim...

 

[cevatyildiz]

Peki ben kendimi çok iyi anlatamadım Ekte örnek dosya var. Sonuc sayfasındaki bilgiler ile Bilgici sayfasındaki 5 degisken birbirini tutuyorsa 3 bilgiyi sonuc sayfasına yazdırıyor.

Fakat her satırda A sütununa tıklamam lazım ki sonuclar geliyor. Her satırda ayrı ayrı A hücresine girmek istemiyorum. Bir defada tüm sayfayı tarasın ve uygun olan 3 bilgiyi tüm satırlara getirsin istiyorum.

 

[askm]

If Intersect(Target, Range("a3:a50000")) Is Nothing Then Exit Sub satırını If Intersect(Target, Range("a3:h50000")) Is Nothing Then Exit Sub şeklinde değiştirirseniz a dan h ye kadar olan hücrelere veri girerseniz bilgiler gelir.

 

[askm]

Aşağıdaki kodları modüle kopyalayıp çalıştırırsanız da tüm veriler gelir.

Sub veri_getir()

Dim s1, s2
Dim i, b, s, c, p, q

Set s1 = Sheets("Sonuc")
Set s2 = Sheets("Bilgici")
Dim SonSatir As Long
SonSatir = s1.Range("A65536").End(xlUp).Row

For i = 3 To SonSatir
q = s1.Cells(i, "c").Value * 1
b = s1.Cells(i, "e").Value
s = s1.Cells(i, "f").Value
c = s1.Cells(i, "g").Value
p = s1.Cells(i, "h").Value


s1.Cells(i, "i").Value = Null

For k = 2 To s2.Cells(65536, "a").End(xlUp).Row
If q = s2.Cells(k, "g").Value And b = s2.Cells(k, "m").Value And s = s2.Cells(k, "n").Value And c = s2.Cells(k, "o").Value And p = s2.Cells(k, "q").Value Then

    s1.Cells(i, "i").Value = s2.Cells(k, "d").Value
    s1.Cells(i, "j").Value = s2.Cells(k, "s").Value
    s1.Cells(i, "k").Value = s2.Cells(k, "t").Value
End If
Next k
Next i
Set s1 = Nothing
Set s2 = Nothing

End Sub

 

[cevatyildiz]

Sn askm çok teşekkür ederim

Satır satır biraz yavaş çalışıyor ama sonuçta istediğimi yapıyor. Vlookup fonksiyonu ile 5 değişekenin kontrolünü yaptırıp 3 bilgiyi getirme olasılığımız yok mudur?