Aynı sayfanın kod bölümünde farklı iki otomatik çağırma nasıl yapılır?

[Tevfik_Kursun]

Merhaba Arkadaşlar,
Bir sayfanın kod bölümünde iki defa Private Sub Worksheet_Change(ByVal Target As Range) (hücredeki değer değiştiğinde otomatik çağırma) nasıl kullanılır?
Birincisi 10286 bilginin içinde yaklaşık 250 sini seçiyor. İkincisi bunların arasından (üç - beş - on) her ne varsa ...
Sayfa1 de birinci seçim örneği, Sayfa2 de ikinci seçim örneği, Sayfa3 birinciyi yapıp ikinciyi aynı bölgede arama
Daha önce birinci aramayı ancak 24 saniyeye indirebilmiştim, şimdi 5 saniyeye indi. (Bunun için tekrar teşekkür ederim)
Saygılarımla

 

[Muzaffer Ali]

Merhaba.

Aşağıdaki kodları kullanabilirsiniz.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target = "" Or Selection.Count > 1 Then Exit Sub
    If Not Intersect(Target, [E1]) Is Nothing Then
        son = WorksheetFunction.Max(Cells(Rows.Count, "A").End(3).Row, 5)
        eski = WorksheetFunction.Max(Cells(Rows.Count, "G").End(3).Row, 5)
        Range("G5:G" & eski).ClearContents
        For i = 5 To son
            If Cells(i, "A") = Target Then
                yeni = WorksheetFunction.Max(Cells(Rows.Count, "G").End(3).Row + 1, 5)
                Cells(yeni, "G") = i
            End If
            If Cells(i, "B") = Target Then
                yeni = WorksheetFunction.Max(Cells(Rows.Count, "G").End(3).Row + 1, 5)
                Cells(yeni, "G") = i
            End If
            If Cells(i, "C") = Target Then
                yeni = WorksheetFunction.Max(Cells(Rows.Count, "G").End(3).Row + 1, 5)
                Cells(yeni, "G") = i
            End If
        Next
    End If
    If Not Intersect(Target, [I1]) Is Nothing Then
        son = WorksheetFunction.Max(Cells(Rows.Count, "H").End(3).Row, 5)
        eski = WorksheetFunction.Max(Cells(Rows.Count, "I").End(3).Row, 5)
        
        Range("I5:I" & eski).ClearContents
        For i = 5 To son
            If Replace(WorksheetFunction.Proper(Cells(i, "H")), WorksheetFunction.Proper(Target), "") <> WorksheetFunction.Proper(Cells(i, "H")) Then
                yeni = WorksheetFunction.Max(Cells(Rows.Count, "I").End(3).Row + 1, 5)
                Cells(yeni, "I") = i
            End If
        Next
    End If
End Sub

 

[Tevfik_Kursun]

Merhaba Sayın Dalgalıkur,
İlginize çok teşekkür ederim.
Saygılarımla

 

[Muzaffer Ali]

O satırı silin yerine aşağıdakini kopyalayın.

If Target.Text = "" Or Selection.Count > 1 Then Exit Sub

 

[Tevfik_Kursun]

Çok makbule geçti.
Saygılarımla

 

[Tevfik_Kursun]

Merhaba Sayın Dalgalıkur,
Hatamı buldum arkadaşım. Çok teşekkür ederim.
Saygılarımla