• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Otomatik Veri Girişine Zorlaması Hk.

  • Konbuyu başlatan Konbuyu başlatan ijol
  • Başlangıç tarihi Başlangıç tarihi
I

ijol

Katılım
22 Nisan 2006
Mesajlar
125
Merhaba,

Bir hücreye veri gişiyi yaptığım zaman, diğer hücrelere veri girişine otomatik yönlenridirmesi gibi bir durum söz konusumudur.

Ekte bulunan dosyada ilk olarak A4'e veri girildiği zaman önce B4 veya C4'e veri girişi yapılması 2 hücreden birine veri girişi yapıldı ise E4 veya F4'e veri girişinin yapılmasını ve E4/F4'e veri girişi yapılınca'da H4/I4/J4/K4 hücrelerinden birine verigirişinin yapılması gerekiyor. 4 gruba veri girişi yapılmadan başka bir satıra geçilmemesi gerekiyor.

Bu konuda bana yardımcı olabilirmisiniz.
 

Ekli dosyalar

Selamlar,

Aşağıdaki kodu sayfanızın kod bölümüne uygulayıp denermisiniz.

Kod: 
Option Explicit
 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim WF As WorksheetFunction
    
    On Error GoTo Son
    
    Set WF = WorksheetFunction
    
    Application.EnableEvents = False
    
    If Cells(Target.Row, 1) <> "" Then
        If Target.Column > 3 And WF.CountA(Range("B" & Target.Row & ":C" & Target.Row)) = 0 Then
            MsgBox "B-C sütunlarından birisine veri girişi yapmalısınız !", vbCritical
            Cells(Target.Row, 2).Select
            GoTo Son
        ElseIf Target.Column > 6 And WF.CountA(Range("E" & Target.Row & ":F" & Target.Row)) = 0 Then
            MsgBox "E-F sütunlarından birisine veri girişi yapmalısınız !", vbCritical
            Cells(Target.Row, 5).Select
            GoTo Son
        ElseIf Target.Column > 11 And WF.CountA(Range("H" & Target.Row & ":K" & Target.Row)) = 0 Then
            MsgBox "H-K arasındaki sütunlardan birisine veri girişi yapmalısınız !", vbCritical
            Cells(Target.Row, 8).Select
            GoTo Son
        End If
    End If
 
    If Cells(Target.Row - 1, 1) <> "" Then
        If WF.CountA(Range("B" & Target.Row - 1 & ":C" & Target.Row - 1)) = 0 Then
            MsgBox "Önceki satırda B-C sütunlarından birisine veri girişi yapmalısınız !", vbCritical
            Cells(Target.Row - 1, 2).Select
            GoTo Son
        ElseIf WF.CountA(Range("E" & Target.Row - 1 & ":F" & Target.Row - 1)) = 0 Then
            MsgBox "Önceki satırda E-F sütunlarından birisine veri girişi yapmalısınız !", vbCritical
            Cells(Target.Row - 1, 5).Select
            GoTo Son
        ElseIf WF.CountA(Range("H" & Target.Row - 1 & ":K" & Target.Row - 1)) = 0 Then
            MsgBox "Önceki satırda H-K arasındaki sütunlardan birisine veri girişi yapmalısınız !", vbCritical
            Cells(Target.Row - 1, 8).Select
            GoTo Son
        End If
    End If
    
Son:
    Set WF = Nothing
    Application.EnableEvents = True
End Sub
 
Günaydın,

Korhan Ustat formül güzel ve tam istediğim gibi olmuş fakat ben bunu kendi istediğim tabloya uygulayamadım:(, osebeple size zahmet olmaz ise Formüller 3 üncü satırdan itibaren başlamak kaydı ile, A3'e veri girince E3'e, E3'e veri girince G3 veya H3'e veri girişininin yapılması, G3-H3'e veri girince I3-J3'e veri girişini istemeli ve son olarak I3-J3'den birine veri girince K3-N3 arasında bir hücreye veri girişini isteyen ve aşağıya doğru devam eden bir formül yapabilirmisiniz.
1. ve 2. satırlarda başlıklarım olacak bu sayede tablom tam istediğim formata dönecek.

Şimdiden teşekkür ederim.
 
Selamlar,

Aşağıdaki şekilde denermisiniz.

Kod: 
Option Explicit
 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim WF As WorksheetFunction
    
    On Error GoTo Son
    
    Application.EnableEvents = False
    
    Set WF = WorksheetFunction
    
    If Target.Row >= 3 Then
    
       If Cells(Target.Row, 1) <> "" Then
           If Target.Column > 5 And Cells(Target.Row, "E") = "" Then
               MsgBox "E" & Target.Row & " hücresine veri girişi yapmalısınız !", vbCritical
               Cells(Target.Row, "E").Select
               GoTo Son
           ElseIf Target.Column > 8 And WF.CountA(Range("G" & Target.Row & ":H" & Target.Row)) = 0 Then
               MsgBox "G" & Target.Row & "-" & "H" & Target.Row & " hücrelerinden birisine veri girişi yapmalısınız !", vbCritical
               Cells(Target.Row, 7).Select
               GoTo Son
           ElseIf Target.Column > 10 And WF.CountA(Range("I" & Target.Row & ":J" & Target.Row)) = 0 Then
               MsgBox "I" & Target.Row & "-" & "J" & Target.Row & " hücrelerinden birisine veri girişi yapmalısınız !", vbCritical
               Cells(Target.Row, 9).Select
               GoTo Son
           ElseIf Target.Column > 14 And WF.CountA(Range("K" & Target.Row & ":N" & Target.Row)) = 0 Then
               MsgBox "K" & Target.Row & "-" & "L" & Target.Row & "-" & "M" & Target.Row & "-" & "N" & Target.Row & " hücrelerinden birisine veri girişi yapmalısınız !", vbCritical
               Cells(Target.Row, 11).Select
               GoTo Son
           End If
       End If
    
       If Target.Row > 3 And Cells(Target.Row - 1, 1) <> "" Then
           If Target.Column > 5 And Cells(Target.Row - 1, "E") = "" Then
               MsgBox "E" & Target.Row - 1 & " hücresine veri girişi yapmalısınız !", vbCritical
               Cells(Target.Row - 1, "E").Select
               GoTo Son
           ElseIf Target.Column > 8 And WF.CountA(Range("G" & Target.Row - 1 & ":H" & Target.Row - 1)) = 0 Then
               MsgBox "G" & Target.Row - 1 & "-" & "H" & Target.Row - 1 & " hücrelerinden birisine veri girişi yapmalısınız !", vbCritical
               Cells(Target.Row - 1, 7).Select
               GoTo Son
           ElseIf Target.Column > 10 And WF.CountA(Range("I" & Target.Row - 1 & ":J" & Target.Row - 1)) = 0 Then
               MsgBox "I" & Target.Row - 1 & "-" & "J" & Target.Row - 1 & " hücrelerinden birisine veri girişi yapmalısınız !", vbCritical
               Cells(Target.Row - 1, 9).Select
               GoTo Son
           ElseIf Target.Column > 14 And WF.CountA(Range("K" & Target.Row - 1 & ":N" & Target.Row - 1)) = 0 Then
               MsgBox "K" & Target.Row - 1 & "-" & "L" & Target.Row - 1 & "-" & "M" & Target.Row - 1 & "-" & "N" & Target.Row - 1 & " hücrelerinden birisine veri girişi yapmalısınız !", vbCritical
               Cells(Target.Row - 1, 11).Select
               GoTo Son
           End If
       End If
    End If
    
Son:
    Set WF = Nothing
    Application.EnableEvents = True
End Sub
 
Selamlar,

Halbuki kodları deneyerek vermiştim. Çalışmayan bölüm neresidir?
 
slm üstat,

hiç çalışmadı anlamadığım konu zaten o, rica etsem excel dosyasın da ekte gönderebilirmisiniz.

ben 2003 ingilizce kullanıyorum onunla alakası olabilirmi?
 
üstat, oklarla sağa götürünce sorguya zorluyor, enter'a basınca işlem yapmıyor.
Bilgine,
 
Selamlar,

Birde aşağıdaki kodu denermisiniz.

Bir üst satırın A sütunundaki hücrede veri girişi varsa ve diğer zorunlu sütunlara veri girişi yapılmamışsa uyarı verir.

Kod: 
Option Explicit
 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim WF As WorksheetFunction
    
    On Error GoTo Son
    
    Application.EnableEvents = False
    
    Set WF = WorksheetFunction
    
    If Target.Row > 3 Then
       If Cells(Target.Row - 1, 1) <> "" Then
           If Cells(Target.Row - 1, "E") = "" Then
               MsgBox "E" & Target.Row - 1 & " hücresine veri girişi yapmalısınız !", vbCritical
               Cells(Target.Row - 1, "E").Select
               GoTo Son
           ElseIf WF.CountA(Range("G" & Target.Row - 1 & ":H" & Target.Row - 1)) = 0 Then
               MsgBox "G" & Target.Row - 1 & "-" & "H" & Target.Row - 1 & " hücrelerinden birisine veri girişi yapmalısınız !", vbCritical
               Cells(Target.Row - 1, 7).Select
               GoTo Son
           ElseIf WF.CountA(Range("I" & Target.Row - 1 & ":J" & Target.Row - 1)) = 0 Then
               MsgBox "I" & Target.Row - 1 & "-" & "J" & Target.Row - 1 & " hücrelerinden birisine veri girişi yapmalısınız !", vbCritical
               Cells(Target.Row - 1, 9).Select
               GoTo Son
           ElseIf WF.CountA(Range("K" & Target.Row - 1 & ":N" & Target.Row - 1)) = 0 Then
               MsgBox "K" & Target.Row - 1 & "-" & "L" & Target.Row - 1 & "-" & "M" & Target.Row - 1 & "-" & "N" & Target.Row - 1 & " hücrelerinden birisine veri girişi yapmalısınız !", vbCritical
               Cells(Target.Row - 1, 11).Select
               GoTo Son
           End If
       End If
    End If
    
Son:
    Set WF = Nothing
    Application.EnableEvents = True
End Sub
 
korhan üstat verdiğin son makro kodu tam oldu. Aklıma geldi A sutununa veri girişi yapmadan diğerlerine veri girişi yapılabiliyor. Son gönderdiğiniz makroya öncelikle A3'den veri girişine başlanması veri hücrelerinin hepsine veri girilince ancak A4 Satırına veri girmeye izin verilmesi gibi bir makro eklenebilirmi?
 
merhaba,

aşağıdaki makro kod'da A3 hücresi itibari ile belli hücrelere veri girişi yapılmadan aşağıya inilemez uyarısı veriyor. Bu makroda yeni farkkettiğim bir sıkıntı var örneğin A3 veri girişine başlandığı zaman bir yer boş kaldığında enter'a basıldığında uyarıyı verirken A5 hücresinden itibaren veri girişi yapılmak istediğinde bu uyarıyı vermemektedir. Ben bir satırdaki verilerin hepsi girilmeden kesinlikle aşağıya geçilmesini istemiyorum. Bu şekilde bir düzeltme yapabilirmisiniz.


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim WF As WorksheetFunction

On Error GoTo Son

Application.EnableEvents = False

Set WF = WorksheetFunction

If Target.Row > 3 Then
If Cells(Target.Row - 1, 1) <> "" Then
If Cells(Target.Row - 1, "E") = "" Then
MsgBox "E" & Target.Row - 1 & " hücresine veri girişi yapmalısınız !", vbCritical
Cells(Target.Row - 1, "E").Select
GoTo Son
ElseIf WF.CountA(Range("G" & Target.Row - 1 & ":H" & Target.Row - 1)) = 0 Then
MsgBox "G" & Target.Row - 1 & "-" & "H" & Target.Row - 1 & " hücrelerinden birisine veri girişi yapmalısınız !", vbCritical
Cells(Target.Row - 1, 7).Select
GoTo Son
ElseIf WF.CountA(Range("I" & Target.Row - 1 & ":J" & Target.Row - 1)) = 0 Then
MsgBox "I" & Target.Row - 1 & "-" & "J" & Target.Row - 1 & " hücrelerinden birisine veri girişi yapmalısınız !", vbCritical
Cells(Target.Row - 1, 9).Select
GoTo Son
ElseIf WF.CountA(Range("K" & Target.Row - 1 & ":N" & Target.Row - 1)) = 0 Then
MsgBox "K" & Target.Row - 1 & "-" & "L" & Target.Row - 1 & "-" & "M" & Target.Row - 1 & "-" & "N" & Target.Row - 1 & " hücrelerinden birisine veri girişi yapmalısınız !", vbCritical
Cells(Target.Row - 1, 11).Select
GoTo Son
End If
End If
End If

Son:
Set WF = Nothing
Application.EnableEvents = True
End Sub
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst