Hỏi cách ràng buộc nhập dữ liệu (2 người xem)

[siv2]

Em có 1 bảng mà em muốn trước khi nhập số tiền ở 1 ô thì các ô cùng dòng trên các cột khác bắt buộc phải nhập đầy đủ dữ liệu. Anh chị giúp em theo file dưới . Em cảm ơn !!!!

 

[snow25]

Em có 1 bảng mà em muốn trước khi nhập số tiền ở 1 ô thì các ô cùng dòng trên các cột khác bắt buộc phải nhập đầy đủ dữ liệu. Anh chị giúp em theo file dưới . Em cảm ơn !!!!

Thử cái code này.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim i As Long
    If Not Intersect(Target, Range("G2:G1000")) Is Nothing Then
       If Target.Count > 1 Then GoTo khongnhap
       For i = 1 To 6
           If Len(Target.Offset(, -i).Value) = 0 Then
              GoTo khongnhap
           End If
       Next i
    End If
Exit Sub
khongnhap:
MsgBox "du lieu nhap thieu"
Target.Offset(, -1).Select
End Sub

 

[bebo021999]

Bạn click chuột phải vào tên sheet, nhấn vô View Code, sau đó dán đoạn code này vô nhé.
Lưu file dạng. xlsm.

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim count&, oldV
If Intersect(Target, Range("G2:G25")) Is Nothing Or Target.count > 1 Or Target.Value = "" Then Exit Sub
With Target
    count = WorksheetFunction.CountA(Range(Cells(.Row, "A"), Cells(.Row, "F")))
End With
If count < 6 Then
    MsgBox "Chua nhap du du lieu"
    With Application
        .EnableEvents = False
        .Undo
        oldV = Target.Value
        Target.Value = oldV
        .EnableEvents = True
    End With
End If
End Sub

 

[siv2]

Em đã làm được cảm ơn các bác nhiều nhé !!!!!!!!!!!!!!!!!!!!!!!!!!

 

[siv2]

Bạn click chuột phải vào tên sheet, nhấn vô View Code, sau đó dán đoạn code này vô nhé.
Lưu file dạng. xlsm.

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim count&, oldV
If Intersect(Target, Range("G2:G25")) Is Nothing Or Target.count > 1 Or Target.Value = "" Then Exit Sub
With Target
    count = WorksheetFunction.CountA(Range(Cells(.Row, "A"), Cells(.Row, "F")))
End With
If count < 6 Then
    MsgBox "Chua nhap du du lieu"
    With Application
        .EnableEvents = False
        .Undo
        oldV = Target.Value
        Target.Value = oldV
        .EnableEvents = True
    End With
End If
End Sub

Bác cho e nhờ thêm chút là khi e copy vào 1 file có cod khác thì nó báo như thế này thì giờ phải làm thế nào ạ

 

[bebo021999]

Một worksheet chỉ có 1 worksheet_Change event thôi, do đó bạn phải ghép 2 đoạn làm 1:

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim count&, oldV

' Copy đoạn code cũ của bạn vào đây
    If...
    ...
    End if
'-----------
'Code mới
If Not Intersect(Target, Range("G2:G25")) Is Nothing Then 
With Target
    count = WorksheetFunction.CountA(Range(Cells(.Row, "A"), Cells(.Row, "F")))
End With
If count < 6 Then
    MsgBox "Chua nhap du du lieu"
    With Application
        .EnableEvents = False
        .Undo
        oldV = Target.Value
        Target.Value = oldV
        .EnableEvents = True
    End With
End If
End if
End Sub

 

[siv2]

Một worksheet chỉ có 1 worksheet_Change event thôi, do đó bạn phải ghép 2 đoạn làm 1:

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim count&, oldV

' Copy đoạn code cũ của bạn vào đây
    If...
    ...
    End if
'-----------
'Code mới
If Not Intersect(Target, Range("G2:G25")) Is Nothing Then
With Target
    count = WorksheetFunction.CountA(Range(Cells(.Row, "A"), Cells(.Row, "F")))
End With
If count < 6 Then
    MsgBox "Chua nhap du du lieu"
    With Application
        .EnableEvents = False
        .Undo
        oldV = Target.Value
        Target.Value = oldV
        .EnableEvents = True
    End With
End If
End if
End Sub

Em gà mờ vba này lắm, e đã thử làm như bác nói rồi mà không được, bác có thể ghép giúp em được không ạ , cod cũ của e đây ạ:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, Range("A5:A10000,H5:H10000,A3:B3")) Is Nothing Then
Cance = True
AdvancedCalendar2
End If
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A5:A10000,H5:H10000,A3:B3")) Is Nothing Then
If Target.Count = 1 Then
If IsDate(Target.value) = False Then
MsgBox "Sai Dinh Dang", vbCritical
Target.Select
AdvancedCalendar2
End If
End If
End If
End Sub

 

[bebo021999]

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim count&, oldV

' Copy đoạn code cũ của bạn vào đây
If Not Intersect(Target, Range("A5:A10000,H5:H10000,A3:B3")) Is Nothing Then
If Target.Count = 1 Then
If IsDate(Target.value) = False Then
MsgBox "Sai Dinh Dang", vbCritical
Target.Select
AdvancedCalendar2
End If
End If
End If
'-----------
'Code mới
If Not Intersect(Target, Range("G2:G25")) Is Nothing Then 
With Target
    count = WorksheetFunction.CountA(Range(Cells(.Row, "A"), Cells(.Row, "F")))
End With
If count < 6 Then
    MsgBox "Chua nhap du du lieu"
    With Application
        .EnableEvents = False
        .Undo
        oldV = Target.Value
        Target.Value = oldV
        .EnableEvents = True
    End With
End If
End if
End Sub

 

[siv2]

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim count&, oldV

' Copy đoạn code cũ của bạn vào đây
If Not Intersect(Target, Range("A5:A10000,H5:H10000,A3:B3")) Is Nothing Then
If Target.Count = 1 Then
If IsDate(Target.value) = False Then
MsgBox "Sai Dinh Dang", vbCritical
Target.Select
AdvancedCalendar2
End If
End If
End If
'-----------
'Code mới
If Not Intersect(Target, Range("G2:G25")) Is Nothing Then
With Target
    count = WorksheetFunction.CountA(Range(Cells(.Row, "A"), Cells(.Row, "F")))
End With
If count < 6 Then
    MsgBox "Chua nhap du du lieu"
    With Application
        .EnableEvents = False
        .Undo
        oldV = Target.Value
        Target.Value = oldV
        .EnableEvents = True
    End With
End If
End if
End Sub

Em vẫn không làm được bác ạ, cái này e dốt quá. Thôi bác thương thì thương cho chót . Em đưa file thực tế bác làm giúp e với được không ạ. Cụ thể ở bên Chi em muốn phải nhập hết các cột A B C D E F thì mới nhập được tiền ở cột G, tương tự thế ở bên Thu phải nhập H I J thì mới nhập dc ở cột K . Mong bác giúp e ạ !

 

[siv2]

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim count&, oldV

' Copy đoạn code cũ của bạn vào đây
If Not Intersect(Target, Range("A5:A10000,H5:H10000,A3:B3")) Is Nothing Then
If Target.Count = 1 Then
If IsDate(Target.value) = False Then
MsgBox "Sai Dinh Dang", vbCritical
Target.Select
AdvancedCalendar2
End If
End If
End If
'-----------
'Code mới
If Not Intersect(Target, Range("G2:G25")) Is Nothing Then
With Target
    count = WorksheetFunction.CountA(Range(Cells(.Row, "A"), Cells(.Row, "F")))
End With
If count < 6 Then
    MsgBox "Chua nhap du du lieu"
    With Application
        .EnableEvents = False
        .Undo
        oldV = Target.Value
        Target.Value = oldV
        .EnableEvents = True
    End With
End If
End if
End Sub

Em làm như bác đến lúc được rồi thì code hiện lịch của e lại không dc ạ

 

[bebo021999]

Em làm như bác đến lúc được rồi thì code hiện lịch của e lại không dc ạ

dòng thứ 3 từ trên xuống sai chính tả nhé ("Cance"):
Cancel = True