AccessTr.neT
Şartlı Veri Girmek - Baskı Önizleme

+- AccessTr.neT (https://accesstr.net)
+-- Forum: Microsoft Excel (https://accesstr.net/forum-microsoft-excel.html)
+--- Forum: Excel Cevaplanmış Soruları (https://accesstr.net/forum-excel-cevaplanmis-sorulari.html)
+--- Konu Başlığı: Şartlı Veri Girmek (/konu-sartli-veri-girmek.html)

Sayfalar: 1 2 3


RE: Şartlı Veri Girmek - feraz - 23/05/2021

(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.

[Resim: do.php?img=11056]
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.


RE: Şartlı Veri Girmek - feraz - 23/05/2021

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

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

[Resim: do.php?img=11062]
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



RE: Şartlı Veri Girmek - m_demir - 23/05/2021

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


RE: Şartlı Veri Girmek - feraz - 23/05/2021

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



RE: Şartlı Veri Girmek - feraz - 23/05/2021

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