Eksik olan nedir?

[Tevfik_Kursun]

Merhaba Arkadaşlar,

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Text = "" Or Selection.Count > 1 Then Exit Sub
    If Not Intersect(Target, [N2]) Is Nothing Then
        son = WorksheetFunction.Max(Cells(Rows.Count, "D").End(3).Row, 5)
        eski = WorksheetFunction.Max(Cells(Rows.Count, "O").End(3).Row, 5)
        Range("O3:O52").ClearContents
        For i = 2 To son
            If Cells(i, "D") = Target Then
                yeni = WorksheetFunction.Max(Cells(Rows.Count, "O").End(3).Row + 1, 3)
                 Cells(yeni, "O") = i
            End If
        Next
    End If
End Sub

Bu haliyle N2 de otomatik çalışıyor.

Sub GetirYaz()
    If Target.Text = "" Or Selection.Count > 1 Then Exit Sub
    If Not Intersect(Target, [N2]) Is Nothing Then
        son = WorksheetFunction.Max(Cells(Rows.Count, "D").End(3).Row, 5)
        eski = WorksheetFunction.Max(Cells(Rows.Count, "O").End(3).Row, 5)
        Range("O3:O52").ClearContents

        For i = 2 To son

            If Cells(i, "D") = Target Then
                yeni = WorksheetFunction.Max(Cells(Rows.Count, "O").End(3).Row + 1, 3)
                 Cells(yeni, "O") = i
            End If
        Next
    End If
End Sub

Bu haliyle N2 de değişiklik yapıp makroyu çalıştırınca Object Required diye hata veriyor.
Bu hata nasıl önlenebilir?
Saygılarımla

 

[PLİNT]

Merhaba
"Sub GetirYaz()" makrosu içinde "target" yerine "selection.cells" veya "activecell" kullanarak önlenebilir.

 

[Tevfik_Kursun]

Merhaba Sayın Plint,
İlginize teşekkür ederim, ama hatayı ilk satırda veriyordu. Şimdi hata vermiyor ama işlem de yapmıyor.
Saygılarımla.

 

[PLİNT]

Merhaba
Rica ederim, saygı bizden, dosyayı indirme imkanım yok ama,
makronun ikinci satırında "N2" hücresinin seçili olma şartı bulunuyor; çalışmama sebebi olabilir.

Sub GetirYaz()
    If [N2].Text = "" Or Selection.Count > 1 Then Exit Sub
    '----------------'
    If Not Intersect(ActiveCell, [N2]) Is Nothing Then
    '----------------'
        son = WorksheetFunction.Max(Cells(Rows.Count, "D").End(3).Row, 5)
        'eski = WorksheetFunction.Max(Cells(Rows.Count, "O").End(3).Row, 5)
        Range("O3:O52").ClearContents

        For i = 2 To son

            If Cells(i, "D") = [N2] Then
                yeni = WorksheetFunction.Max(Cells(Rows.Count, "O").End(3).Row + 1, 3)
                 Cells(yeni, "O") = i
            End If
        Next
    End If
End Sub

 

[Tevfik_Kursun]

Merhaba,
N2 hücresine bakıp kıyaslayacak, eşit olanın satır numarasını getirecek.
https://www.dosya.tc/server22/r6sabq/Ornek_TK2.rar.html
İnceleyebilirsiniz.
İyi çalışmalar

 

[PLİNT]

Sadece "N2" hücresindeki değere bağlı ise aşağıdaki gibi olacaktır,

Sub GetirYaz()
    If [N2] = "" Then Exit Sub
        son = WorksheetFunction.Max(Cells(Rows.Count, "D").End(3).Row, 5)
        Range("O3:O52").ClearContents
        For i = 2 To son
            If Cells(i, "D") = [N2] Then
                yeni = WorksheetFunction.Max(Cells(Rows.Count, "O").End(3).Row + 1, 3)
                 Cells(yeni, "O") = i
            End If
        Next
End Sub

"N" sütunundaki herhangi bir hücre içinde ekteki gibi yapabilirsiniz
https://s2.dosya.tc/server10/s5l3zr/Ornek_TK3.zip.html

 

[Tevfik_Kursun]

İlginize çok teşekkür ederim arkadaşım.
Saygılarımla

 

[Tevfik_Kursun]

Sayın Plint,
Sonucu alt alta değil de yan yana isteseydim nerede değişiklik olurdu?
Saygılarımla

 

[PLİNT]

Merhaba
"O2" hücresinden itibaren şöyle;

Sub GetirYaz()
    If [N2] = "" Then Exit Sub
        son = WorksheetFunction.Max(Cells(Rows.Count, "D").End(3).Row, 5)
        Range(Cells(2, "O"), Cells(2, Columns.Count)).ClearContents
        For i = 2 To son
            If Cells(i, "D") = [N2] Then
                Cells(2, Cells(2, Columns.Count).End(xlToLeft).Column + 1) = i
            End If
        Next
End Sub

 

[Tevfik_Kursun]

İlginize çok teşekkür ederim sayın Plint.
İyi geceler