iki ayrı worksheet_change makrosunu çalıştırma

[yselimyilmaz]

Selam arkadaşlar;
aşağıda yazılı bulunan makroları çalışma sayfamda aynı anda çalıştıramıyorum.


1. makro
imlecin enterla gitmesi gereken hücreler için..

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Target.Address = "$D$2" And Target > 0 Then [G2].Select
If Target.Address = "$G$2" And Target > 0 Then [D4].Select
If Target.Address = "$D$4" And Target > 0 Then [D5].Select
If Target.Address = "$D$5" And Target > 0 Then [D6].Select
If Target.Address = "$D$6" And Target > 0 Then [D7].Select
If Target.Address = "$D$7" And Target > 0 Then [D8].Select
If Target.Address = "$D$8" And Target > 0 Then [D9].Select
If Target.Address = "$D$9" And Target > 0 Then [D10].Select
If Target.Address = "$D$10" And Target > 0 Then [G4].Select
If Target.Address = "$G$4" And Target > 0 Then [G6].Select
If Target.Address = "$G$6" And Target > 0 Then [G8].Select
If Target.Address = "$G$8" And Target > 0 Then [G9].Select
If Target.Address = "$G$9" And Target > 0 Then [G10].Select
If Target.Address = "$G$10" And Target > 0 Then [D12].Select
If Target.Address = "$D$12" And Target > 0 Then [D13].Select
If Target.Address = "$D$13" And Target > 0 Then [D14].Select
If Target.Address = "$D$14" And Target > 0 Then [G12].Select
If Target.Address = "$G$12" And Target > 0 Then [G13].Select
If Target.Address = "$G$13" And Target > 0 Then [G14].Select
End Sub

2. makro TC kimlik no kontrolü....

Private Sub Worksheet_Change(ByVal Target As Range)
'On Error Resume Next
If Intersect(Target, Range(["D4"])) Is Nothing Then Exit Sub
If Len(Target) <> 11 Then
MsgBox "TC Kimlik numarası 11 Rakamdan oluşmalıdır.", vbCritical, "Hatalı !" 'X
'Target.Text = ""
Exit Sub
End If

Dim mod1 As Integer, mod2 As Integer, TC1 As Integer, TC2 As Integer, TC3 As Integer, TC4 As Integer, TC5 As Integer, TC6 As Integer, TC7 As Integer, TC8 As Integer, TC9 As Integer, TC10 As Integer, TC11 As Integer
TC1 = Mid(Target, 1, 1)
TC2 = Mid(Target, 2, 1)
TC3 = Mid(Target, 3, 1)
TC4 = Mid(Target, 4, 1)
TC5 = Mid(Target, 5, 1)
TC6 = Mid(Target, 6, 1)
TC7 = Mid(Target, 7, 1)
TC8 = Mid(Target, 8, 1)
TC9 = Mid(Target, 9, 1)
TC10 = Mid(Target, 10, 1)
TC11 = Mid(Target, 11, 1)

mod1 = ((((TC1 + TC3 + TC5 + TC7 + TC9) * 7) - (TC2 + TC4 + TC6 + TC8)) Mod 10)
mod2 = ((TC1 + TC2 + TC3 + TC4 + TC5 + TC6 + TC7 + TC8 + TC9 + TC10) Mod 10)

If mod1 = TC10 And mod2 = TC11 Then

Else
MsgBox Target & " Geçersiz TC kimlik numarası", vbExclamation, "Dikkat !"
End If

End Sub

 

[askm]

Private Sub Worksheet_Change(ByVal Target As Range)
'On Error Resume Next
If Not Intersect(Target, Range(["D4"])) Is Nothing Then 
If Len(Target) <> 11 Then
MsgBox "TC Kimlik numarası 11 Rakamdan oluşmalıdır.", vbCritical, "Hatalı !" 'X
'Target.Text = ""
Exit Sub
End If

Dim mod1 As Integer, mod2 As Integer, TC1 As Integer, TC2 As Integer, TC3 As Integer, TC4 As Integer, TC5 As Integer, TC6 As Integer, TC7 As Integer, TC8 As Integer, TC9 As Integer, TC10 As Integer, TC11 As Integer
TC1 = Mid(Target, 1, 1)
TC2 = Mid(Target, 2, 1)
TC3 = Mid(Target, 3, 1)
TC4 = Mid(Target, 4, 1)
TC5 = Mid(Target, 5, 1)
TC6 = Mid(Target, 6, 1)
TC7 = Mid(Target, 7, 1)
TC8 = Mid(Target, 8, 1)
TC9 = Mid(Target, 9, 1)
TC10 = Mid(Target, 10, 1)
TC11 = Mid(Target, 11, 1)

mod1 = ((((TC1 + TC3 + TC5 + TC7 + TC9) * 7) - (TC2 + TC4 + TC6 + TC8)) Mod 10)
mod2 = ((TC1 + TC2 + TC3 + TC4 + TC5 + TC6 + TC7 + TC8 + TC9 + TC10) Mod 10)

If mod1 = TC10 And mod2 = TC11 Then

Else
MsgBox Target & " Geçersiz TC kimlik numarası", vbExclamation, "Dikkat !"
End If
end if

On Error Resume Next
If Target.Address = "$D$2" And Target > 0 Then [G2].Select
If Target.Address = "$G$2" And Target > 0 Then [D4].Select
If Target.Address = "$D$4" And Target > 0 Then [D5].Select
If Target.Address = "$D$5" And Target > 0 Then [D6].Select
If Target.Address = "$D$6" And Target > 0 Then [D7].Select
If Target.Address = "$D$7" And Target > 0 Then [D8].Select
If Target.Address = "$D$8" And Target > 0 Then [D9].Select
If Target.Address = "$D$9" And Target > 0 Then [D10].Select
If Target.Address = "$D$10" And Target > 0 Then [G4].Select
If Target.Address = "$G$4" And Target > 0 Then [G6].Select
If Target.Address = "$G$6" And Target > 0 Then [G8].Select
If Target.Address = "$G$8" And Target > 0 Then [G9].Select
If Target.Address = "$G$9" And Target > 0 Then [G10].Select
If Target.Address = "$G$10" And Target > 0 Then [D12].Select
If Target.Address = "$D$12" And Target > 0 Then [D13].Select
If Target.Address = "$D$13" And Target > 0 Then [D14].Select
If Target.Address = "$D$14" And Target > 0 Then [G12].Select
If Target.Address = "$G$12" And Target > 0 Then [G13].Select
If Target.Address = "$G$13" And Target > 0 Then [G14].Select

End Sub

 

[yselimyilmaz]

Yardımcı olduğunuz için teşekkür ederim