Tạo điều kiện khi nhập vào cell

[kobebryant]

Em có 2 cột mã từ F9 đến G100, theo điều kiện thì phải nhập mã hàng là số hoặc kết hợp số lẫn chữ phải trên 4 ký tự.
Nếu nhập sai thì sẽ hiện thông báo và xóa ô đó đi nhập lại.
Theo code em viết thì bị lỗi là nó cứ hiện thông báo lên hoài nếu lỡ nhập ít hơn 4 ký tự hoặc nếu ô đó có sẵn 3 ký tự nhấn delete đi thì nó bị lỗi tương tự.
Em hạn chế không dùng Data Validation Text Length.
Tiện thể cho em hỏi nếu copy một hoặc nhiều mã hàng ít hơn 4 ký tự từ bên ngoài vào thì có cách nào khống chế hay thông báo không ạ vì cái này khá quan trọng.

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Range("F9:G100"), Target) Is Nothing Then
    If Len(Target) < 4 Then
        Msgbox "Nhap ma phai it nhat 4 ky tu, vui long nhap lai", vbCritical
        Target.ClearContents
        Exit Sub
    End If
End If
End Sub

Xin cám ơn

 

[vu_tuan_manh_linh]

Em có 2 cột mã từ F9 đến G100, theo điều kiện thì phải nhập mã hàng là số hoặc kết hợp số lẫn chữ phải trên 4 ký tự.
Nếu nhập sai thì sẽ hiện thông báo và xóa ô đó đi nhập lại.
Theo code em viết thì bị lỗi là nó cứ hiện thông báo lên hoài nếu lỡ nhập ít hơn 4 ký tự hoặc nếu ô đó có sẵn 3 ký tự nhấn delete đi thì nó bị lỗi tương tự.
Em hạn chế không dùng Data Validation Text Length.
Tiện thể cho em hỏi nếu copy một hoặc nhiều mã hàng ít hơn 4 ký tự từ bên ngoài vào thì có cách nào khống chế hay thông báo không ạ vì cái này khá quan trọng.

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Range("F9:G100"), Target) Is Nothing Then
    If Len(Target) < 4 Then
        Msgbox "Nhap ma phai it nhat 4 ky tu, vui long nhap lai", vbCritical
        Target.ClearContents
        Exit Sub
    End If
End If
End Sub

Xin cám ơn

Bạn cho nó cái điều kiện if target.value<>"" thì chạy đoạn code dưới.

 

[kobebryant]

Bạn cho nó cái điều kiện if target.value<>"" thì chạy đoạn code dưới.

Dạ ok rồi anh, em copy 1 mã ít hơn 4 ký tự thì nó báo lỗi, nhưng copy nhiều mã lẫn lộn thì nó báo lỗi. Có cách khắc phục ko anh.

 

[vu_tuan_manh_linh]

Dạ ok rồi anh, em copy 1 mã ít hơn 4 ký tự thì nó báo lỗi, nhưng copy nhiều mã lẫn lộn thì nó báo lỗi. Có cách khắc phục ko anh.

Đọc đi đọc lại câu của bạn không hiểu gì luôn!

 

[kobebryant]

Đọc đi đọc lại câu của bạn không hiểu gì luôn!

tức là copy mã từ bên ngoài vào vùng nhập liệu thay vì nhập trực tiếp.
Nếu copy 1 cell ít hơn 4 ký tự dán vào vùng nhập liệu thì nó có báo lỗi. Nhưng nếu copy nhiều cell vừa hơn 4 ký tự và vừa ít hơn 4 ký tự thì nó báo code lỗi và vẫn cho dán vào

 

[giaiphap]

tức là copy mã từ bên ngoài vào vùng nhập liệu thay vì nhập trực tiếp.
Nếu copy 1 cell ít hơn 4 ký tự dán vào vùng nhập liệu thì nó có báo lỗi. Nhưng nếu copy nhiều cell vừa hơn 4 ký tự và vừa ít hơn 4 ký tự thì nó báo code lỗi và vẫn cho dán vào

Bạn thử code này xem, mình chưa test bạn tự kiểm tra.

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Range("F9:G100"), Target) Is Nothing Then
    Dim sCell As Range
    Application.EnableEvents = False
    For Each sCell In Target
        If Len(sCell) < 4 Then
            'MsgBox "Nhap ma phai it nhat 4 ky tu, vui long nhap lai", vbCritical
            sCell.ClearContents
        End If
    Next sCell
    Application.EnableEvents = True
End If
End Sub

 

[kobebryant]

Bạn thử code này xem, mình chưa test bạn tự kiểm tra.

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Range("F9:G100"), Target) Is Nothing Then
    Dim sCell As Range
    Application.EnableEvents = False
    For Each sCell In Target
        If Len(sCell) < 4 Then
            'MsgBox "Nhap ma phai it nhat 4 ky tu, vui long nhap lai", vbCritical
            sCell.ClearContents
        End If
    Next sCell
    Application.EnableEvents = True
End If
End Sub

Tuyệt vời quá anh ơi, chạy ok rồi
Nhưng bị 1 cái khó chịu là ở những ô có mã sẵn, em muốn delete nội dung đi thì nó cứ hiện msgbox. Xóa 100 cell thì nó hiện 100 msgbox phê quá

 

[giaiphap]

Tuyệt vời quá anh ơi, chạy ok rồi
Nhưng bị 1 cái khó chịu là ở những ô có mã sẵn, em muốn delete nội dung đi thì nó cứ hiện msgbox. Xóa 100 cell thì nó hiện 100 msgbox phê quá

Cái đó là do bạn lập trình thôi, muốn thông báo một lần thì ra khỏi vòng lặp mới dùng msgbox.

 

[kobebryant]

Cái đó là do bạn lập trình thôi, muốn thông báo một lần thì ra khỏi vòng lặp mới dùng msgbox.

Anh giúp em với, em cho khỏi vòng lặp thì mỗi lần nhập liệu đúng xong nó là nó lại báo, còn tệ hơn ban đầu

 

[giaiphap]

Anh giúp em với, em cho khỏi vòng lặp thì mỗi lần nhập liệu đúng xong nó là nó lại báo, còn tệ hơn ban đầu

Dùng code này và nghiệm ra cái mình cần.

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Range("F9:G100"), Target) Is Nothing Then
    Dim sCell As Range, ErrRng As Range
    Application.EnableEvents = False
    For Each sCell In Target
        If Len(sCell) < 4 Then            
            sCell.ClearContents
            If ErrRng Is Nothing Then
                Set ErrRng = sCell
            Else
                Set ErrRng = Union(ErrRng, sCell)
            End If
        End If
    Next sCell
    Application.EnableEvents = True
    If Not (ErrRng Is Nothing) Then MsgBox "Nhung o du lieu chua dung: " & ErrRng.Address, vbCritical
End If
End Sub

 

[kobebryant]

Dùng code này và nghiệm ra cái mình cần.

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Range("F9:G100"), Target) Is Nothing Then
    Dim sCell As Range, ErrRng As Range
    Application.EnableEvents = False
    For Each sCell In Target
        If Len(sCell) < 4 Then           
            sCell.ClearContents
            If ErrRng Is Nothing Then
                Set ErrRng = sCell
            Else
                Set ErrRng = Union(ErrRng, sCell)
            End If
        End If
    Next sCell
    Application.EnableEvents = True
    If Not (ErrRng Is Nothing) Then MsgBox "Nhung o du lieu chua dung: " & ErrRng.Address, vbCritical
End If
End Sub

Tới những dòng code này em thua hihi, có thêm cơ hội để em nghiên cứu thêm hàm Union thế nào rồi. Cám ơn anh

 

[kobebryant]

Dùng code này và nghiệm ra cái mình cần.

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Range("F9:G100"), Target) Is Nothing Then
    Dim sCell As Range, ErrRng As Range
    Application.EnableEvents = False
    For Each sCell In Target
        If Len(sCell) < 4 Then         
            sCell.ClearContents
            If ErrRng Is Nothing Then
                Set ErrRng = sCell
            Else
                Set ErrRng = Union(ErrRng, sCell)
            End If
        End If
    Next sCell
    Application.EnableEvents = True
    If Not (ErrRng Is Nothing) Then MsgBox "Nhung o du lieu chua dung: " & ErrRng.Address, vbCritical
End If
End Sub

À có cách nào mình xóa mà nó không báo không anh, em mới thử delete 200 Entirerow nó đứng máy luôn rồi.

 

[giaiphap]

À có cách nào mình xóa mà nó không báo không anh, em mới thử delete 200 Entirerow nó đứng máy luôn rồi.

Thay chổ

If Len(sCell) < 4  Then

thành

If (Len(sCell) < 4) And (sCell <> Empty) Then

 

[kobebryant]

Thay chổ

If Len(sCell) < 4  Then

thành

If (Len(sCell) < 4) And (sCell <> Empty) Then

Dạ ổn nhiều rồi. Cám ơn anh.
Anh nhiệt tình quá, giờ này mà anh vẫn reply lại giúp em. Chúc anh cuối tuần vui vẻ