Düşey Ara formülünü makroya çevir

[işsiz123]

Merhabalar
A:A sütununa t.c girdiğimde B:B ve C:C verilerini düşey ara ile sayfa2 den dolduruyor. Ama bazen A:A yerine B:B verileri girmem gerekiyor ama B:B sütununda formül olduğu için giremiyorum. bunu nasıl makroya çevirebiliriz. Saygılarımla.

 

[Haluk]

Aslında aradığınız şey, aşağıdaki linkte yer alan dosyadaki gibi.... bir inceleyin isterseniz.

Arama yapılacak alanı seçip, aramaya ilişkin kriterle verilerin bulunması...

https://www.excel.web.tr/threads/soezlesme-takip-dosyasi.181364/post-1001567

.

 

[işsiz123]

Öncelikle teşekkürler Userform yerine direk hücrelerde olsa daha iyi olurdu.

 

[Haluk]

Ben direkt olarak kullanın demedim zaten, dosyanızdaki tabloları biraz düzenlerseniz benzer bir kodla yapabilirsiniz demek istedim...

.

 

[EmrExcel16]

istediğiniz aşağıdaki kodla çözülebilir mi acaba sayfanın kod bölümüne yapıştırıp deneyiniz.

Private Sub Worksheet_Change(ByVal Target As Range)

If Intersect(Target, [A2:B100000]) Is Nothing Then Exit Sub

Application.EnableEvents = False
If Target.Column = 1 Then
    Set bul = Sheets("Sayfa2").Range("A:A").Find(Target, , xlValues, xlWhole)
    If Not bul Is Nothing Then
        Cells(Target.Row, 2).Value = Sheets("Sayfa2").Cells(bul.Row, 2).Value
        Cells(Target.Row, 3).Value = Sheets("Sayfa2").Cells(bul.Row, 3).Value
    Else
        Cells(Target.Row, 2).Value = ""
        Cells(Target.Row, 3).Value = ""
    End If
Else
    Set bul = Sheets("Sayfa2").Range("B:B").Find(Target, , xlValues, xlWhole)
    If Not bul Is Nothing Then
        Cells(Target.Row, 1).Value = Sheets("Sayfa2").Cells(bul.Row, 1).Value
        Cells(Target.Row, 3).Value = Sheets("Sayfa2").Cells(bul.Row, 3).Value
    Else
        Cells(Target.Row, 1).Value = ""
        Cells(Target.Row, 3).Value = ""
    End If
End If
Application.EnableEvents = True

End Sub

 

[işsiz123]

Teşekkürler

istediğiniz aşağıdaki kodla çözülebilir mi acaba sayfanın kod bölümüne yapıştırıp deneyiniz.

Private Sub Worksheet_Change(ByVal Target As Range)

If Intersect(Target, [A2:B100000]) Is Nothing Then Exit Sub

Application.EnableEvents = False
If Target.Column = 1 Then
    Set bul = Sheets("Sayfa2").Range("A:A").Find(Target, , xlValues, xlWhole)
    If Not bul Is Nothing Then
        Cells(Target.Row, 2).Value = Sheets("Sayfa2").Cells(bul.Row, 2).Value
        Cells(Target.Row, 3).Value = Sheets("Sayfa2").Cells(bul.Row, 3).Value
    Else
        Cells(Target.Row, 2).Value = ""
        Cells(Target.Row, 3).Value = ""
    End If
Else
    Set bul = Sheets("Sayfa2").Range("B:B").Find(Target, , xlValues, xlWhole)
    If Not bul Is Nothing Then
        Cells(Target.Row, 1).Value = Sheets("Sayfa2").Cells(bul.Row, 1).Value
        Cells(Target.Row, 3).Value = Sheets("Sayfa2").Cells(bul.Row, 3).Value
    Else
        Cells(Target.Row, 1).Value = ""
        Cells(Target.Row, 3).Value = ""
    End If
End If
Application.EnableEvents = True

End Sub

 

[EmrExcel16]

Teşekkürler

Rica ederim.

 

[emrebenn]

Bu kodu B stunundan z stununa kadar çalisacak nasil sekilde nasil degiştirmeliyim beceremedim

 

[işsiz123]

Nasıl bir şey yapmak istiyorsunuz tam açıklasanız yardımcı olmaya çalışayım.

 

[emrebenn]

Ürun adıni verdigim veritabanı olarak kullandigim bir sayfam var.Buradaki bilgileri Takip adli sayfamda a sutuna stok yazip b den z ye kadar olan stunlari bu formulle doldurtmak istiyorum.

 

[işsiz123]

Cells(Target.Row, 2).Value = Sheets("Sayfa2").Cells(bul.Row, 2).Value ' Burdaki 2 sütun numarası yani 2 ve B sütununu temsil ediyor . Burdn yola çıkarak yapabilirsiniz. Olmadı örnek dosyanızı gönderirsiniz.

 

[emrebenn]

Formullerle çalişmaktan daha güzel oldu.Teşekkür ederim.