AccessTr.neT

Tam Versiyon: Vba İle Döndüyü Sağlayıp Veriyi Çekmek
Şu anda arşiv modunu görüntülemektesiniz. Tam versiyonu görüntülemek için buraya tıklayınız.
Sayfalar: 1 2 3 4 5 6 7
(30/09/2022, 14:44)berduş yazdı: [ -> ]With ThisWorkbook.Sheets("T1") satırının altına aşağıdaki kodu yazıp dener misiniz?

    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, "ABCD", 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

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

Cells üzerinde hata verdi
kodu nereye yazdınız
tümünü ekler misiniz?
(30/09/2022, 14:44)berduş yazdı: [ -> ]With ThisWorkbook.Sheets("T1") satırının altına aşağıdaki kodu yazıp dener misiniz?

    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, "ABCD", 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

YARDIMLARIN İÇİN TEŞEKKÜR EDERİM SAĞOLASIN.
(30/09/2022, 15:13)berduş yazdı: [ -> ]kodu nereye yazdınız
tümünü ekler misiniz?

burada 2 soru sormuşum
kodu nereye yazdığınızı ve tüm kodu.
siz sadece kodun bir kısmını yazmışsınız diğer soruma ise cevap bile yazmamışsınız?
siz yeterli açıklama yapmazsanız yardımcı olamayız
(30/09/2022, 15:34)berduş yazdı: [ -> ]
(30/09/2022, 15:13)berduş yazdı: [ -> ]kodu nereye yazdınız
tümünü ekler misiniz?

burada 2 soru sormuşum
kodu nereye yazdığınızı ve tüm kodu.
siz sadece kodun bir kısmını yazmışsınız diğer soruma ise cevap bile yazmamışsınız?
siz yeterli açıklama yapmazsanız yardımcı olamayız

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, "ABCD", 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 Sub

bu şekilde düzenledim. yıldan sadece 2019 calışıyor, diğer yılları görmüyor."ABCD" kısmı 15/a 25/c 18/d.. şeklinde yazabilirmiyiz
End With EKLENMEMİŞ
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, "ABCD", 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
Sayfalar: 1 2 3 4 5 6 7