buộc phải nhập dữ liệu theo quy ước (1 người xem)

[Blad01]

nhờ các bác viết giúp em đoạn code buộc người sử dụng phải nhập dữ liệu vào bảng tính là chữ x (chữ thường). Nếu người dùng nhập các ký tự khác thì bảng tính cũng tự chuyển các ký tự đó sang chữ x.
Vùng buộc phải nhập dữ liệu là chữ x như sau: D8:I12 và L8: AD12. Lưu ý: TỪ DÒNG 8 ĐẾN DÒNG 12 NGƯỜI DÙNG CÓ THỂ INSERT THÊM DÒNG
Mong các bác giúp em với nhé.
FILE đính kèm:

 

[jack nt]

Define Name xRange Refers to D8:I12,L8: AD12

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Cll As Range, RngChange As Range
    Set RngChange = Intersect(Range(Sheet1.Names("xRange")), Target)
    If Not RngChange Is Nothing Then
        For Each Cll In RngChange
            If Cll <> vbNullString Then
                Cll = "x"
            End If
        Next
    End If
End Sub

p/s:
- sử dụng Name thì có thể Insert thoải mái
- vòng lặp For cho phép Paste vào nhiều ô

 

[Blad01]

[Xin giúp] khống chế nhập dữ liệu và cảnh báo người dùng khi nhập sai

Em có bảng dữ liệu buộc người dùng phải tích chữ x vào vùng nhập liệu (từ D7:H10), nếu sử dụng ký tự khác để nhập thì báo lỗi hoặc tích sai thẩm quyền của cấp kiểm tra cũng báo lỗi. Cụ thể như sau:
1. Người dùng buộc phải nhập chữ x vào vùng nhập liệu, nếu nhập sai thì báo cho người dùng biết để sửa lại.
2. Nếu người dùng tích x vào cấp kiểm tra là Đảng uỷ cơ sở thì chỉ được tích x vào cột đảng viên thuộc cấp cơ sở quản lý. Nếu tích x vào cột đảng viên thuộc cấp tỉnh và cấp huyện quản lý thì sẽ xuất hiện bảng thông báo để người dùng biết mình đã tích sai.
Không biết có cách nào làm được các vấn đề em nêu trên không, mong các bác giúp đỡ. Em xin cảm ơn.

 

[Blad01]

Define Name xRange Refers to D8:I12,L8: AD12

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Cll As Range, RngChange As Range
    Set RngChange = Intersect(Range(Sheet1.Names("xRange")), Target)
    If Not RngChange Is Nothing Then
        For Each Cll In RngChange
            If Cll <> vbNullString Then
                Cll = "x"
            End If
        Next
    End If
End Sub

p/s:
- sử dụng Name thì có thể Insert thoải mái
- vòng lặp For cho phép Paste vào nhiều ô

Cảm ơn bác nhiều lắm. bác Jack nt có thể làm giúp em vào file đính kèm được không. Em không biết gì về vba cả. Đặt tên như thế nào vậy bác. Một lần nữa cảm ơn bác nhiều.

 

[Blad01]

Bác nào làm vào file đính kèm giúp em với ạ, em copy đoạn code của bác Jack nt vào file dữ liệu của em để chạy thử nó toàn báo lỗi: Run time error "1004". Application-Defined or object Defined error.

 

[chuot0106]

Bác nào làm vào file đính kèm giúp em với ạ, em copy đoạn code của bác Jack nt vào file dữ liệu của em để chạy thử nó toàn báo lỗi: Run time error "1004". Application-Defined or object Defined error.

Đưa File của bạn nên đây xem sao?

 

[Blad01]

Đưa File của bạn nên đây xem sao?

Cảm ơn bác, file của em có ở bài đầu tiên rồi.còn đây là file em đã chép đoạn code của bác Jack nt vào

 

[chuot0106]

Cảm ơn bác, file của em có ở bài đầu tiên rồi.còn đây là file em đã chép đoạn code của bác Jack nt vào

Bạn đặt tên name chưa?

 

[Let'GâuGâu]

tôi thấy đoạn code này

Set RngChange = Intersect(Range(Sheet1.Names("xRange"))

sao không xác định dòng cuối bằng lệnh end(xlup) mà phải đặt name?

 

[chuot0106]

Cảm ơn bác, file của em có ở bài đầu tiên rồi.còn đây là file em đã chép đoạn code của bác Jack nt vào

Chép đoạn code này vào File thử xem sao:

Private Sub Worksheet_Change(ByVal Target As Range)

Dim Rng As Range, Cll As Range, Lr As Long
Lr = Sheet1.Range("A10000").End(xlUp).Row
Set Rng = Union(Sheet1.Range("D8:I" & Lr - 1), Sheet1.Range("L8:R" & Lr - 1))
If Not Intersect(Target, Rng) Is Nothing Then
Application.EnableEvents = False
    For Each Cll In Rng
         If Cll <> "" Then Cll = "x"
    Next
Application.EnableEvents = True
End If
End Sub

 

[Blad01]

Bạn đặt tên name chưa?

Em đặt tên name của mảng dữ liệu là xRange rồi nhưng vẫn lỗi

 

[chuot0106]

Em đặt tên name của mảng dữ liệu là xRange rồi nhưng vẫn lỗi

Chép đoạn code của tôi bên trên vào File và test thử chưa?

 

[Blad01]

Chép đoạn code này vào File thử xem sao:

Private Sub Worksheet_Change(ByVal Target As Range)

Dim Rng As Range, Cll As Range, Lr As Long
Lr = Sheet1.Range("A10000").End(xlUp).Row
Set Rng = Union(Sheet1.Range("D8:I" & Lr - 1), Sheet1.Range("L8:R" & Lr - 1))
If Not Intersect(Target, Rng) Is Nothing Then
Application.EnableEvents = False
    For Each Cll In Rng
         If Cll <> "" Then Cll = "x"
    Next
Application.EnableEvents = True
End If
End Sub

Em làm được theo cách của bác rồi, nhưng sao nó chạy hơi chậm bác ạ. Nếu copy dữ liệu từ bảng tính khác vào thì code không chạy bác ạ. bác khắc phục giúp em được không

 

[jack nt]

Cảm ơn bác nhiều lắm. bác Jack nt có thể làm giúp em vào file đính kèm được không. Em không biết gì về vba cả. Đặt tên như thế nào vậy bác. Một lần nữa cảm ơn bác nhiều.

Private Sub Worksheet_Change(ByVal Target As Range)
    Static n&
    Dim Cll As Range, RngChange As Range
    Set RngChange = Intersect(Range(Sheet1.Names("xRange")), Target)
    If Not RngChange Is Nothing Then
        For Each Cll In RngChange
            If Cll <> vbNullString Then
                [COLOR=#ff0000]Application.EnableEvents = False[/COLOR]
                Cll = "x"
                [COLOR=#ff0000]Application.EnableEvents = True[/COLOR]
            End If
        Next
    End If
    Set RngChange = Nothing
End Sub

Tui không biết bạn đã định dạng những gì cho Table2 mà sự kiện _Change xảy ra liên tục. Đành phải khóa nó bằng EnableEvent = False.
Còn để define name bạn vào “Formulas”, ở khúc giữa có “Define name”. Nhớ chọn Scope là “Sheet1”
Bạn nào rành về Table vui lòng giải thích tại sao Worksheet_Change lại xảy ra liên tục vậy?

 

[chuot0106]

Tui không biết bạn đã định dạng những gì cho Table2 mà sự kiện _Change xảy ra liên tục. Đành phải khóa nó bằng EnableEvent = False.
Bạn nào rành về Table vui lòng giải thích tại sao Worksheet_Change lại xảy ra liên tục vậy?[/QUOTE]
Tôi cũng không hiểu tại sao lại xảy ra lỗi vòng lặp lặp vô tận này nữa! Tôi bi đơ máy mấy lần liên!

 

[Blad01]

Cảm ơn bác Jack nt và chuot0106 nhiều lắm, hai bác giỏi về vba có thể xem giúp em bài này với được không ạ: http://www.giaiphapexcel.com/forum/...ữ-được-các-chức-năng-trong-bảng-Protect-Sheet

 

[Let'GâuGâu]

To ban jack nt
Bạn thử ra một sheet mới toanh xem nó có bị vậy ko?

 

[jack nt]

To ban jack nt
Bạn thử ra một sheet mới toanh xem nó có bị vậy ko?

thì codes lúc đầu là viết với sheet mới, chạy thử không sao mới dám post lên.