İYİ GÜNLER ÜSTADLARIM. AŞAĞIDAKİ KODU ÇALIŞTIRAMADIM...

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
                    Set bul = .Range("B1:" & .Cells(1, SonStn).Address).Find(Year(Cells(Target.Row, "C").Value), , , 1)
                    Set kaydir = .Range("A:A").Find(Cells(Target.Row, "E").Value, , , 1)
                    If (Not bul Is Nothing) And (Not kaydir Is Nothing) Then Cells(Target.Row, "F").Value = .Cells(kaydir.Row, bul.Column).Value
        End If
      End If
    End With
    Set bul = Nothing

If Target

On Error Resume Next
    Dim X As Long, No As Long
    If Intersect(Target, Range("B2:B65536")) Is Nothing Then ' B2 koşulun Hangi Hücrede başlasın'
    Target.Offset(0, -1).Font.Color = vbRed ' Rekli Sayı Verir'
    Application.ScreenUpdating = False
   
    For X = 2 To Selection.SpecialCells(xlCellTypeLastCell).Row  'x=2 koşulun Hangi Hücrede başlasın'
        If Cells(X, "A").MergeArea.Count = 1 Then
            If Cells(X, "B") <> "" And Cells(X, "A") <> "Sıra No" Then
                No = No + 1
                Cells(X, "A") = No
            Else
                If Cells(X, "A") <> "Sıra No" Then
                    Cells(X, "A").ClearContents
                End If
            End If
        End If
    Next
    Application.ScreenUpdating = True
End Sub

Çalışmanızı inceleyemedim ama koddan gördüğüm kadarıyla 2. If target koşulunun devamı yok

(13/04/2023, 12:38)berduş yazdı: Çalışmanızı inceleyemedim ama koddan gördüğüm kadarıyla 2. If target koşulunun devamı yok

Emli dosyada if target i iptal ederek denedim yine olmadı

---

(13/04/2023, 12:45)HORZUM yazdı:

(13/04/2023, 12:38)berduş yazdı: Çalışmanızı inceleyemedim ama koddan gördüğüm kadarıyla 2. If target koşulunun devamı yok

Ekli dosyada if target i iptal ederek denedim yine olmadı

kodunuzun başına Application.EnableEvents = False , sonuna da Application.EnableEvents = true eklemeyi dener misiniz?
kullandığınız Cells(X, "A").ClearContents kodu A sütunundaki veriyi değiştirdiğinden kod Worksheet_Change kodunu 2 kez bu sefer A sütunundaki hücre üzerinden çalıştırıyor
Target.Offset(0, -1) buradaki -1 ifadesi A sütunundan önceki sütunu bulmaya çalışıyor ama bu hataya sebep oluyor

(13/04/2023, 13:36)berduş yazdı: kodunuzun başına Application.EnableEvents = False , sonuna da Application.EnableEvents = true eklemeyi dener misiniz?
kullandığınız Cells(X, "A").ClearContents kodu A sütunundaki veriyi değiştirdiğinden kod Worksheet_Change kodunu 2 kez bu sefer A sütunundaki hücre üzerinden çalıştırıyor
Target.Offset(0, -1) buradaki -1 ifadesi A sütunundan önceki sütunu bulmaya çalışıyor ama bu hataya sebep oluyor

Hata halloldu ama B sutununa veri girince sıra no yu otomatik atmıyor. Ayrıca b sutunundaki veriyi silince Cells(X, "A").ClearContents çalışmıyor. üst kısımdaki
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
Set bul = .Range("B1:" & .Cells(1, SonStn).Address).Find(Year(Cells(Target.Row, "C").Value), , , 1)
Set kaydir = .Range("A:A").Find(Cells(Target.Row, "E").Value, , , 1)
If (Not bul Is Nothing) And (Not kaydir Is Nothing) Then Cells(Target.Row, "F").Value = .Cells(kaydir.Row, bul.Column).Value
End If
End If
End With
Set bul = Nothing

kodunu silince normal çalışıyor

ilk mesajınızda açıklama yapmadınız, kodun ne yapması gerektiğinden bahsetmediniz sadece çalışmıyor dediniz ben de hatayı düzelttim.
ayrıca kabalığınızı da anlamıyorum, karşınızda uşağınız yada emir eriniz yok.
o kadar emek ve zaman harcıyoruz en azından, işinize yaramasa bile, bir teşekkür hak ediyoruz.