makro kilitleniyor

[Erdem Akdemir]

Arkadaşlar merhaba

Aşağıdaki kod çalışıyor ama kilitlenme ve kendini kapatma kısmını bir türlü çözemedim

Herkese iyi çalışmalar

Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo son
If Target.Column = 2 Then
    If Target.Count > 1 Then
        For i = 1 To Target.Count
            If Selection(i, 1).Value <> "" Then
                Selection(i, 1).Offset(0, -1).Value = Selection(i, 1).Row
                Selection(i, 1).Offset(0, 1).Value = "TÜRKİYE"
            End If
Next i
    ElseIf Target.Value <> "" Then
        Cells(Target.Row, 1).Value = Target.Row
        Cells(Target.Row, 3).Value = "TÜRKİYE"
    Else
        Cells(Target.Row, 1).Value = ""
        Cells(Target.Row, 3).Value = ""
    End If
End If
If Target.Column = 7 Then
    If Target.Count > 1 Then
        For i = 1 To Target.Count
   If Selection(i, 1).Value <> "" Then
                    Selection(i, 1).Value = Int(Selection(i, 1))
                      End If

        Next i
        
        ElseIf Target.Value <> "" Then
        Cells(Target.Row, 7) = Int(Target.Value)
        End If
        
End If
If Intersect(Target, [d:d]) Is Nothing Then Exit Sub
For t = 1 To [d1000].End(3).Row
If Len(Cells(i, 4)) = 11 Then
Cells(i, 5) = Cells(i, 4)
Cells(i, 4).Clear
End If
Next t

son:
End Sub

 

[leumruk]

Merhaba,
Kilitlenmeden kastınız kodun sürekli kendini yenileyerek çalışması mı?

 

[Erdem Akdemir]

Merhaba,
Kilitlenmeden kastınız kodun sürekli kendini yenileyerek çalışması mı?

evet üstad, düzeltemedim bir türlü

 

[leumruk]

Merhaba,
Kodu aşağıdaki gibi dener misiniz?

Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo son
Application.EnableEvents = False
If Target.Column = 2 Then
    If Target.Count > 1 Then
        For i = 1 To Target.Count
            If Selection(i, 1).Value <> "" Then
                Selection(i, 1).Offset(0, -1).Value = Selection(i, 1).Row
                Selection(i, 1).Offset(0, 1).Value = "TÜRKİYE"
            End If
        Next i
    ElseIf Target.Value <> "" Then
        Cells(Target.Row, 1).Value = Target.Row
        Cells(Target.Row, 3).Value = "TÜRKİYE"
    Else
        Cells(Target.Row, 1).Value = ""
        Cells(Target.Row, 3).Value = ""
    End If
End If
If Target.Column = 7 Then
    If Target.Count > 1 Then
        For i = 1 To Target.Count
   If Selection(i, 1).Value <> "" Then
                    Selection(i, 1).Value = Int(Selection(i, 1))
                      End If

        Next i
        
        ElseIf Target.Value <> "" Then
        Cells(Target.Row, 7) = Int(Target.Value)
        End If
        
End If
If Target.Column = 4 Then
For t = 1 To [d1000].End(3).Row
If Len(Cells(t, 4)) = 11 Then
Cells(t, 5) = Cells(t, 4)
Cells(t, 4).Clear
Application.EnableEvents = True
End If
Next t
End If
son:
Application.EnableEvents = True
End Sub

 

[Erdem Akdemir]

sayın leumruk "D" sütununa 11 haneli kod girdiğimde otomatik olarak "E" sütununa geçirip, "D" sütunundaki verinin kendisini silmesi lazımdı, makronun son kısmında sıkıntı var.

 

[leumruk]

Kodu güncelledim. Yeniden deneyebilirsiniz.

 

[Erdem Akdemir]

sayın leumruk çok sağolun