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ı.
Vba İle Döndüyü Sağlayıp Veriyi Çekmek
(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)
Son Düzenleme: 03/10/2022, 08:41, Düzenleyen: HORZUM.
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
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.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
sizin örneğe göre düzenledim. dosya ektedir.
Konuyu Okuyanlar: