Vba İle Döndüyü Sağlayıp Veriyi Çekmek

Not: konu başlığı olarak "lütfen, yardım vs vs " gibi ifadeler kullanmayın; konu başlığı, içeriğiyle uyumlu kısa bir açıklama olmalı.

(30/09/2022, 17:38)berduş yazdı: Not: konu başlığı olarak "lütfen, yardım  vs vs " gibi ifadeler kullanmayın; konu başlığı, içeriğiyle uyumlu kısa bir açıklama olmalı.

Anladım. Teşekkürederim.

Ayrıca kaydir = InStr(1, "ABCD", Cells(Target.Row, "E").Value, vbTextCompare) satırındaki "ABCD" yerine "15/a 21/b 68/c 79/k ..." gibi ifadeler yazabilirmiyiz. denedim olmadı.

Anlamadım biraz daha açıklar mısınız?

(03/10/2022, 08:32)berduş yazdı: Anlamadım biraz daha açıklar mısınız?

kaydir = InStr(1, "5/a 21/b 68/c 79/k", Cells(Target.Row, "E").Value, vbTextCompare) gibi. arasına virgül yaptım denedim veri alamadım.

Böyle yaptım kaydir = InStr(1, "5/a,21/b,68/c,79/k", Cells(Target.Row, "E").Value, vbTextCompare)

T1 sayfasında ilgili hücreleri düzenledikten sonra hakediş iptal sayfasında veri doğrulamada E sütununda bu değerlerin göründüğünden emin olun ve @berduş Hocamın paylaştığı kodu buna göre

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim bul As Range

    Dim trh As Date

    Dim CsutunTarih As Date

        

  

    With ThisWorkbook.Sheets("T1")

If (Target.Column = 3 Or Target.Column = 5) And Target.Row >= 1 Then

        If IsDate(Cells(Target.Row, "c")) And Len(Cells(Target.Row, "E") & "") > 0 Then

            SonStn = Cells(1, Columns.Count).End(xlToLeft).Column

            kaydir = InStr(1, "15/a21/b68/c79/k99/q", Cells(Target.Row, "E").Value, vbTextCompare)

                    Set bul = .Range("B1:" & .Cells(1, SonStn).Address).Find(Year(Cells(Target.Row, "C").Value), , , 1)

                    If Not bul Is Nothing Then Cells(Target.Row, "F").Value = bul.Offset(kaydir).Value

        End If

    End If

    End With

    Set bul = Nothing

End Sub

olarak revize ederseniz istediğiniz gibi olacaktır. A,B,C,D için değerler (15/a, 21/b, 68/c, 79/k) vermişsiniz E için 99/q ben uydurdum siz ona göre düzenlersiniz.

(03/10/2022, 08:39)atoykan yazdı: T1 sayfasında ilgili hücreleri düzenledikten sonra hakediş iptal sayfasında veri doğrulamada E sütununda bu değerlerin göründüğünden emin olun ve @berduş Hocamın paylaştığı kodu buna göre

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim bul As Range

    Dim trh As Date

    Dim CsutunTarih As Date

        

  

    With ThisWorkbook.Sheets("T1")

If (Target.Column = 3 Or Target.Column = 5) And Target.Row >= 1 Then

        If IsDate(Cells(Target.Row, "c")) And Len(Cells(Target.Row, "E") & "") > 0 Then

            SonStn = Cells(1, Columns.Count).End(xlToLeft).Column

            kaydir = InStr(1, "15/a21/b68/c79/k99/q", Cells(Target.Row, "E").Value, vbTextCompare)

                    Set bul = .Range("B1:" & .Cells(1, SonStn).Address).Find(Year(Cells(Target.Row, "C").Value), , , 1)

                    If Not bul Is Nothing Then Cells(Target.Row, "F").Value = bul.Offset(kaydir).Value

        End If

    End If

    End With

    Set bul = Nothing

End Sub

olarak revize ederseniz istediğiniz gibi olacaktır. A,B,C,D için değerler (15/a, 21/b, 68/c, 79/k) vermişsiniz E için 99/q ben uydurdum siz ona göre düzenlersiniz.

sizin örneğe göre düzenledim. dosya ektedir.