(19/11/2020, 23:26)hayalibey yazdı: Bir de b sütunda 6 rakam denetlemesi yapmıyor malesef

Alttaki kodun görevi zaten o.

If Cells(Target.Row, 2).Value <> "" And Len(Cells(Target.Row, 2).Value + 0) <> 6 Then Exit Sub

---

If strText = False Then Exit Sub bu kodu değiştirdim.Boşsa çık komutu yazmıştım.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Dim Açýklama_Ekleme As Comment

Dim strText



If Target.Column > 37 Then Exit Sub



If Cells(Target.Row, 2).Value <> "" And Len(Cells(Target.Row, 2).Value + 0) <> 6 Then Exit Sub

If Cells(Target.Row, Target.Column).Comment Is Nothing Then

    strText = Application.InputBox("Eklenecek olan mesajý aþaðýya yazýnýz.", _

              "Açýklama_Ekleme", "Açýklama Ekler", , , , 2)

Else

    strText = Application.InputBox("Eklenecek olan mesajý aþaðýya yazýnýz.", _

              "Açýklama_Ekleme", Target.Comment.text, , , , 2)

End If



If strText = "" Then

    Target.Comment.Delete

    Exit Sub

End If

'On Error Resume Next

If strText = False Then Exit Sub

On Error GoTo 0

If Application.ExecuteExcel4Macro("Get.Cell(46)") = True Then

    Target.Comment.Delete

End If

Target.AddComment

Set Açýklama_Ekleme = Target.Comment

With Açýklama_Ekleme

    .text text:=strText

    With .Shape.TextFrame.Characters.Font

        .Name = "Arial"

        .Size = 8

        .Bold = False

    End With

End With



End Sub