fırıldak ile bulunan değere karşılık değer atama

[cebelitarık]

Sevgili forum üyeleri bayramınız kutlu olsun.
Makroyu düğmeye bağlamadan fırıldağın çalışması ile birlikte veya elle değer girildiğinde;

Ekte sunduğum dosyada fırıldak ile belirlediğimiz sayı değerine göre diğer sayfadan fırıldak değerine karşılık gelen satırdan istediğimiz sütundaki değeri fırıldağın yanındaki hücreye nasıl atayabiliriz
ilgilenen arkadaşlara teşekkür ederim.

 

[cebir]

merhaba..

bir modüle

Sub DeğerDeğiştirici1_Değiştir()
Set s1 = Sheets("VERİLER")
For a = 1 To s1.[A65536].End(3).Row
If Left(s1.Cells(a, "A"), Len(Range("d2").Text)) = Range("d2").Text Then
ActiveSheet.Range("E2").Value = s1.Cells(a, "D")
End If
Next
End Sub

d2 manuel girmek için.
Worksheet_Change(ByVal Target As Range) altına yazılabilir.

 

[cebelitarık]

Sayın cebir ilgine çok teşekkür ederim.
önerdiğin makroyu sayfaya ekledim ancak bazı hatalar veriyor.
örneğin 2 . stırdada aynı ismi veriyor 20 . satırdadada aynı ismi veriyor.
Birde hem fırıldak ile değer değiştirilebilecek hemde manuel olarak değer girilebilecek şekilde olması lazım bazanda makro tıkanıyor.
değiştirilebeilecek kısımları varsa memnun olurum
iyi bayramlar
yeni hali ile dosyam ektedir

 

[cebir]

merhaba..
yukarıdaki kodu şöyle değişelim.

modül e
Sub DeğerDeğiştirici1_Değiştir()
For X = 1 To Sheets("VERİLER").[A65536].End(3).Row
If ActiveSheet.Cells(2, 4).Text = Sheets("VERİLER").Cells(X, 1).Text Then
ActiveSheet.Range("e2").Value = Sheets("VERİLER").Cells(X, 4)
End If
Next
End Sub

manuel olarak.
sayfanın kod sayfasına


Private Sub Worksheet_Change(ByVal Target As Range)
For X = 1 To Sheets("VERİLER").[A65536].End(3).Row
If ActiveSheet.Cells(2, 4).Text = Sheets("VERİLER").Cells(X, 1).Text Then
ActiveSheet.Range("e2").Value = Sheets("VERİLER").Cells(X, 4)
End If
Next
End Sub

 

[cebelitarık]

Sayın Cebir ilgine çok teşekkür ederim.

Döngüyü 100 sayıya indirmeme rağmen çok yavaş çalışıyor.
Bunun döngü haricinde başka bir çözümü varmı ?
örneğin aşağıdaki kodları bu işe uygulayabilirmiyiz.

Private Sub Worksheet_Change(ByVal Target As Range)
sonuc = Cells(Range("A1:A20").Find([C2]).Row, Range("D1").Find([D1]).Column).Value
Cells(2, 5) = sonuc
End Sub

vakti olduğunda ilgilencek arkadaşlara şimdiden teşekkür ederim.