iki ayrı Worksheet_Change yi aynı anda kullanmak

tahsinanarat

Altın Üye
Katılım
14 Mart 2005
Mesajlar
2,167
Excel Vers. ve Dili
Ofis 2019 Türkçe
Altın Üyelik Bitiş Tarihi
27-05-2028
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim AYIR() As String
Dim X As Long, Y As Integer, SAY As Integer

If Intersect(Target, [H1]) Is Nothing Then Exit Sub

Application.ScreenUpdating = False

If Target <> Empty Then
Target.Activate

With Range("BN3:BN" & [B65536].End(3).Row)
.Formula = "=H3 & "" "" & I3 & "" "" & R3 & "" "" & S3"
.Value = .Value
End With

AYIR = Split(Target, " ")
For X = 3 To Range("B1").CurrentRegion.Rows.Count
SAY = 0

For Y = 0 To UBound(AYIR())
If UCase(Replace((Replace(Cells(X, "BN"), "i", "İ")), "ı", "I")) Like "*" & UCase(Replace((Replace(AYIR(Y), "i", "İ")), "ı", "I")) & "*" Then SAY = SAY + 1
Next

If SAY <> (UBound(AYIR()) + 1) Then
Cells(X, "BO") = False
Else
Cells(X, "BO") = True
End If
Next

[B2].AutoFilter Field:=12, Criteria1:=True
Application.ScreenUpdating = True
'MsgBox "İşleminiz tamamlanmıştır.", vbInformation
Else
If ActiveSheet.AutoFilterMode = True Then [A2].AutoFilter
[BN3:BO65536].ClearContents
Application.ScreenUpdating = True
End If
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
ActiveSheet.Unprotect Password:="000187"
Set s1 = Sheets("sucturu")
If Target.Column = 24 Then
'If Intersect(Target, [x3:x65536]) Is Nothing Then Exit Sub
sat = s1.[b1:b65536].Find(Target).Row
Cells(Target.Row, "y") = s1.Cells(sat, "c")
'Cells(Target.Row, "G") = s1.Cells(sat, "g")
Target.Offset(0, 2).Select
End If
If Target.Column = 26 Then Target.Offset(0, 14).Select
If Target.Column = 18 Then
il = Target.Value
Target.Offset(0, 1).Select
If il <> "" Then Call ilceleriAktar(il)
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End If
If ((Target.Address = Target.EntireRow.Address Or _
Target.Address = Target.EntireColumn.Address)) Then
With Application
.EnableEvents = False
.Undo
MsgBox "Satır veya sütun silemezsiniz!Sileceğiniz Hücreleri işaretleyip silmelisiniz", 16
.EnableEvents = True
End With
Else
Exit Sub
End If
'If Target.Column = 24 Then
'suc = Target.Value
'Target.Offset(0, 1).Select
'If suc <> "" Then Call sucturuAktar(suc)
End Sub


yukarıda verdiğim iki kod da tek başına çalışıyor, ben aynı sayfada ikinini aynı anda kullanmam gerekiyor, yardımcı olacak arkadaşlara şimdiden teşekkür ederim.
 
Üst