Şartlı Veri Girmek

(23/05/2021, 00:53)m_demir yazdı:

(22/05/2021, 18:54)feraz yazdı: Modül kodlarını ve thisworkbook koduna eklediğim kodu silip sadece sayfa koduna alttakini ekleyiniz.


https://resim.accesstr.net/do.php?img=11056

Private Sub Worksheet_SelectionChange(ByVal Target As Range)



    If (Target.Column = 2 Or Target.Column = 3 Or Target.Column = 4) And Target.row > 1 Then

        If Cells(Target.row, 1).Value = "" Then

            Cells(Target.row, 1).Select

            MsgBox "hata"

            Exit Sub

        End If

    End If

    

    If (Target.Column = 7 Or Target.Column = 8 Or Target.Column = 9) And Target.row > 1 Then

        If Cells(Target.row, "F").Value = "" Then

            Cells(Target.row, "F").Select

            MsgBox "hata"

            Exit Sub

        End If

    End If

    

End Sub

Hocam gerçi Konuyu kapattık. Eğer sakıncası yoksa B,D,G,I hücrelerini de zorunlu giriş olarak belirliyebilirmiyiz.

Tamam abey.

Gifteki gibi sırasına göre ayarladım abey.


https://resim.accesstr.net/do.php?img=11061


https://resim.accesstr.net/do.php?img=11062

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    Call engelle(Target.Column, 2, 5, Target.Column, Target.row) '2 demek B sütunu icin, 5 ise E sütunu

    Call engelle(Target.Column, 7, 10, Target.Column, Target.row) '7 demek G sütunu icin, 10 ise J sütunu

End Sub

Sub engelle(hedefSutun As Byte, col1 As Byte, col2 As Byte, col3 As Byte, satir As Long)



    Dim i As Byte

    Static sayac As Byte

    

    If sayac > 0 Then

        sayac = 0: Exit Sub

    End If

     

    If (hedefSutun >= col1 And hedefSutun <= col2) And satir > 1 Then

        For i = col1 To hedefSutun

            If Cells(satir, i - 1).Value = "" Then

                sayac = sayac + 1: Cells(satir, i - 1).Select

                MsgBox "hata": Exit Sub

            End If

        Next

    End If

End Sub

Hocam çok, çok teşekkürler ellerinize sağlık. Tam istediğim gibi oldu.

Rica edrim abey.bir parametre gereksiz olmuş.
Ayrıca C ve H sütunları hariç olacaksada kod eklerim.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    Call engelle(Target.Column, 2, 5, Target.row) '2 demek B sütunu icin, 5 ise E sütunu

    Call engelle(Target.Column, 7, 10, Target.row) '7 demek G sütunu icin, 10 ise J sütunu

End Sub

Sub engelle(hedefSutun As Byte, col1 As Byte, col2 As Byte, satir As Long)



    Dim i As Byte

    Static sayac As Byte

    

    If sayac > 0 Then

        sayac = 0: Exit Sub

    End If

    

    If (hedefSutun >= col1 And hedefSutun <= col2) And satir > 1 Then

        For i = col1 To hedefSutun

            If Cells(satir, i - 1).Value = "" Then

                sayac = sayac + 1: Cells(satir, i - 1).Select

                MsgBox "hata": Exit Sub

            End If

        Next

    End If

End Sub

C ve H sütunları hariç için alttaki kodu deneyin.If i = col2 - 1 Then GoTo var ve var: kodları eklendi dasece.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    Call engelle(Target.Column, 2, 5, Target.row) '2 demek B sütunu icin, 5 ise E sütunu

    Call engelle(Target.Column, 7, 10, Target.row) '7 demek G sütunu icin, 10 ise J sütunu

End Sub



Sub engelle(hedefSutun As Byte, col1 As Byte, col2 As Byte, satir As Long)



    Dim i As Byte

    Static sayac As Byte

    

    If sayac > 0 Then

        sayac = 0: Exit Sub

    End If

    

    If (hedefSutun >= col1 And hedefSutun <= col2) And satir > 1 Then

        For i = col1 To hedefSutun

            If i = col2 - 1 Then GoTo var

            If Cells(satir, i - 1).Value = "" Then

                sayac = sayac + 1: Cells(satir, i - 1).Select

                MsgBox "hata": Exit Sub

            End If

var:

        Next

    End If

End Sub