chức năng thêm mới data vào drop down list không chạy khi Protect sheet. (1 người xem)

  • Thread starter Thread starter hhduc
  • Ngày gửi Ngày gửi
Liên hệ QC

Người dùng đang xem chủ đề này

hhduc

Thành viên mới
Tham gia
21/2/11
Bài viết
9
Được thích
0
Hi anh chị,

Em có file excel trong đó tại.

Sheet DNAllItem, ô E10, ô F10 sử dụng drop down list để chọn và có thể nhập trực tiếp để thêm mới nội dung vào danh sách (nơi chứa dữ liệu danh sách là sheet S_AddItemToList . Sau khi nhập mới thì nó sẽ có trong list. Nhấn mũi tên sổ xuống sẽ thấy có.

Do muốn ẩn toàn bộ công thức đi nên em sử dụng Protect sheet với Password. Mọi thứ đều chạy khi protect sheet và công thức đã ẩn đi. Nhưng không thể thêm mới nội dung vào drop down list (nhập mới vào ô drop down list rồi enter, nhấn vào mũi tên sổ xuống không thấy nội dung mới nhập) . Chỉ khi bỏ protect sheet thì mới thêm được.

ô E10, ô F10 em đã bỏ check locked và hidden tại format cell trong tab protection.
Protect sheet đã check tại: select locked cells, select unlocked cells, Format cells, Edit objects, Edit scenarios

Đoạn code Tại sheet DNAllItem là:

Option Explicit
' Developed by Contextures Inc.
'
www.contextures.com


Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
Dim ws As Worksheet
Dim str As String
Dim i As Integer
Dim rngDV As Range
Dim rng As Range


If Target.Count > 1 Then Exit Sub
Set ws = Worksheets("S_AddItemToList")

If Target.Row > 1 Then
On Error Resume Next
Set rngDV = Cells.SpecialCells(xlCellTypeAllValidation)
On Error GoTo 0
If rngDV Is Nothing Then Exit Sub

If Intersect(Target, rngDV) Is Nothing Then Exit Sub

str = Target.Validation.Formula1
str = Right(str, Len(str) - 1)
On Error Resume Next
Set rng = ws.Range(str)
On Error GoTo 0
If rng Is Nothing Then Exit Sub

If Application.WorksheetFunction _
.CountIf(rng, Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, rng.Column).End(xlUp).Row + 1
ws.Cells(i, rng.Column).Value = Target.Value
rng.Sort Key1:=ws.Cells(1, rng.Column), _
Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If


End If


End Sub


Đoạn code Tại sheet S_AddItemToList là:

Option Explicit
' Developed by Contextures Inc.
'
www.contextures.com


Private Sub Worksheet_Change(ByVal Target As Range)
Columns(Target.Column).Sort _
Key1:=Cells(1, Target.Column), _
Order1:=xlAscending, _
Header:=xlNo, _
OrderCustom:=1, _
MatchCase:=False, _
Orientation:=xlTopToBottom
End Sub


Mong anh chị giúp có cách nào Protect sheet rồi, vẫn thêm được dữ liệu mới vào danh sách.

Thank,
 
Web KT

Bài viết mới nhất

Back
Top Bottom