[ÇÖZÜLDÜ] Hücreye yazılan değere göre sayfadan arama yaparak veri getirmek..

[enteresan]

Sevgili excel'ci arkadaşlarım....C sütununda herhangi bir hücreye yazdığım değeri sayfada bulsun ve o hücrenin karşısındaki bilgileri aynı hücreye getirsin istiyorum. EK'teki örnekte daha iyi anlaşılacağı kanaatindeyim. Biraz karışık çünki. Yardımcı olabilirseniz memnun olurum. Saygılar….

 

[Mahmut Kök]

Bir örnek

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    On Error Resume Next
    sat = Range("h1:h65536").Find(ActiveCell.Value).Row
    ActiveCell = Cells(sat, "I")
    ActiveCell.Offset(1, 0) = Cells(sat + 1, "I")
End Sub

 

[enteresan]

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    On Error Resume Next
    sat = Range("h1:h65536").Find(ActiveCell.Value).Row
    ActiveCell = Cells(sat, "I")
    ActiveCell.Offset(1, 0) = Cells(sat + 1, "I")
End Sub

Sevgili mesleki, çok güzel olmuş, eline sağlık. ismi yazar yazmaz değişmiyor ama üzerine tıkladığımızda değişiyor. Yanılıyor muyum? Yazdıktan sonra enter yapınca değişse daha iyi olurdu ama, bu da olur. Çok teşekkür ederim...

 

[Korhan Ayhan]

Selamlar,

Alternatif olarak aşağıdaki kodu denermisiniz.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Application.Intersect(Target, [C:C]) Is Nothing Then Exit Sub
    Set BUL = [H:H].Find(Target)
    If Not BUL Is Nothing Then
    Target.Offset(0, 1) = Cells(BUL.Row, BUL.Column + 1)
    Target.Offset(1, 1) = Cells(BUL.Row + 1, BUL.Column + 1)
    End If
End Sub

 

[enteresan]

Selamlar,

Alternatif olarak aşağıdaki kodu denermisiniz.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Application.Intersect(Target, [C:C]) Is Nothing Then Exit Sub
    Set BUL = [H:H].Find(Target)
    If Not BUL Is Nothing Then
    Target.Offset(0, 1) = Cells(BUL.Row, BUL.Column + 1)
    Target.Offset(1, 1) = Cells(BUL.Row + 1, BUL.Column + 1)
    End If
End Sub

Sevgili Korhan hocam, bu da çok güzel ama, benim istediğim değeri yazdığım hücrenin değişmesiydi, yanındaki hücrenin değil. Yani mesleki rumuzlu arkadaşımın kodları benim istediğim gibi. ama tekrar üzerine tıklamak gerekiyor değiştirmek için. İsmi yazıp enter'e bastığımızda kendiliğinden değişse daha iyi olurdu. Onun dışında tam istediğim gibi.
İlginize teşekkür eder, saygılar sunarım...

 

[Korhan Ayhan]

Selamlar,

Önerdiğim kodu aşağıdaki şekilde değiştirip denermisiniz.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Application.Intersect(Target, [C:C]) Is Nothing Then Exit Sub
    Set BUL = [H:H].Find(Target)
    If Not BUL Is Nothing Then
    Target.Offset(0, 0) = Cells(BUL.Row, BUL.Column + 1)
    Target.Offset(1, 0) = Cells(BUL.Row + 1, BUL.Column + 1)
    End If
End Sub

 

[enteresan]

Selamlar,

Önerdiğim kodu aşağıdaki şekilde değiştirip denermisiniz.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Application.Intersect(Target, [C:C]) Is Nothing Then Exit Sub
    Set BUL = [H:H].Find(Target)
    If Not BUL Is Nothing Then
    Target.Offset(0, 0) = Cells(BUL.Row, BUL.Column + 1)
    Target.Offset(1, 0) = Cells(BUL.Row + 1, BUL.Column + 1)
    End If
End Sub

Evet hocam, istediğim buydu. Çok teşekkür ederim. Saygılar....