Skip to main content

AccessTr.neT


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

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

Çözüldü #13
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ı.
Cevapla
#14
(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ı.
Cevapla
#15
Anlamadım biraz daha açıklar mısınız?
Cevapla
#16
(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.
Cevapla
#17
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.
Cevapla
#18
(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.
.rar Hakedis.rar (Dosya Boyutu: 19,27 KB | İndirme Sayısı: 13)
Cevapla

Bir hesap oluşturun veya yorum yapmak için giriş yapın

Yorum yapmak için üye olmanız gerekiyor

ya da