Hỏi cách ràng buộc nhập dữ liệu

Liên hệ QC
Tôi tuân thủ nội quy khi đăng bài

siv2

Thành viên hoạt động
Tham gia
14/7/12
Bài viết
122
Được thích
7
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 !!!!
 

File đính kèm

  • VD ràng buộc.xlsx
    8.9 KB · Đọc: 8
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.
Mã:
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
 
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.
PHP:
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
 

File đính kèm

  • VD ràng buộc.xlsm
    16.3 KB · Đọc: 9
Em đã làm được cảm ơn các bác nhiều nhé !!!!!!!!!!!!!!!!!!!!!!!!!!
 
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.
PHP:
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 ạUntitled-1.jpg
 
Một worksheet chỉ có 1 worksheet_Change event thôi, do đó bạn phải ghép 2 đoạn làm 1:
PHP:
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
 
Một worksheet chỉ có 1 worksheet_Change event thôi, do đó bạn phải ghép 2 đoạn làm 1:
PHP:
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
 
PHP:
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
 
PHP:
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 ạ !
 

File đính kèm

  • Chi Tiêu 2023 - Copy.xlsm
    217.2 KB · Đọc: 6
PHP:
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 ạ
 

File đính kèm

  • Untitled-1.jpg
    Untitled-1.jpg
    108 KB · Đọc: 19
Web KT
Back
Top Bottom