tự động khóa vùng data

Liên hệ QC

minhbinhdinh

Thành viên chính thức
Tham gia
15/8/08
Bài viết
65
Được thích
3
chào mọi người.
xin mọi người giúp cho đoạn code với ý như sau :
tôi muốn tạo macro tự động tìm cell cuối cùng có data và khóa từ đó trở về trước,các vùng khác không có data thì vẫn được edit bình thường.
mong mọi người giúp cho.
 
chào mọi người.
xin mọi người giúp cho đoạn code với ý như sau :
tôi muốn tạo macro tự động tìm cell cuối cùng có data và khóa từ đó trở về trước,các vùng khác không có data thì vẫn được edit bình thường.
mong mọi người giúp cho.


Mã:
Sub Macro1()
    ActiveSheet.Unprotect
    Cells.Locked = False
    Cells.SpecialCells(xlCellTypeAllValidation).Locked = True
    ActiveSheet.Protect
End Sub
 
Upvote 0
Mã:
Sub Macro1()
    ActiveSheet.Unprotect
    Cells.Locked = False
    Cells.SpecialCells([COLOR=Red]xlCellTypeAllValidation[/COLOR]).Locked = True
    ActiveSheet.Protect
End Sub

(1) Hình như bạn nhầm
xlCellTypeAllValidation. Cells having validation criteria
xlCellTypeLastCell. The last cell in the used range

(2) Tuy nhiên cho phép mình nghi ngờ bạn chưa đến chính xác nơi cần đến
(Từ nguồn: http://www.ozgrid.com/VBA/ExcelRanges.htm cho ta biết rằng:)
Excel Ranges: Finding the Last Cell in a RangeFind the last Row, Column or Cell
You can use Edit>Go to-Special-Last cell to try and find the last cell in the active sheet, but it is not very reliable. The reasons are two-fold:
1. The last cell is only re-set when you save. This means if you enter any number or text in say, cell A10 and A20 of a new Worksheet, then delete the content of A20, the Edit>Go to-Special-Last cell will keep taking you to A20, until you save.
2. It picks up cell fomatting. Let's say you enter any text or number in cell A10 and then enter a valid date in cell A20 of a new Worksheet. Now delete the date in cell A20 and save. The Edit>Go to-Special-Last cell will still take you to A20. This is because entering a date in A20 has caused Excel to automatically format the cell from "General" to a Date format. To stop from going to A20 you will have to use Edit>Clear>All and then save.
So when using VBA you cannot rely on:
Range("A1").SpecialCells(xlCellTypeLastCell).Select
Below are three methods that will find the "LastRow", "LastColumn" and the "LastCell"


(3) Đây là macro để ta đến ô cuối 1 cách chắc cú:
Excel Ranges: Finding the Last Cell in a Range
PHP:
Sub FindLastCell()
Dim LastColumn As Integer, LastRow As Long
Dim LastCell As Range

If WorksheetFunction.CountA(Cells) > 0 Then
  LastRow = Cells.Find(What:="*", After:=[A1], _
     SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

  LastColumn = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByColumns, _
  SearchDirection:=xlPrevious).Column

 MsgBox Cells(LastRow, LastColumn).Address

End If 

End Sub

(4) & Tặng bạn món quà cuối :
PHP:
Sub TimVaHieu()
 Dim Rng As Range, LastRow As Long
 
 Set Rng = Cells.SpecialCells(xlCellTypeLastCell)
 LastRow = Cells.Find(What:="*", After:=Rng.Cells(1, 1), SearchOrder:=xlByRows, _
   SearchDirection:=xlPrevious).Row   
   MsgBox Rng.Address, , Cells.Parent.Name & " " & LastRow 
End Sub
 
Upvote 0
@ ChanhTQ@ Theo đề bài tôi hiểu
- Tìm cell cuối cùng có data chứ không phải là LastCell vì chưa chắc LastCell có Data
- và khóa từ đó trở về trước, các vùng khác không có data thì vẫn được edit bình thường. Có nghĩa là chỉ khoá vùng có Data validation mà thôi.

Không biết Tôi hiểu như vậy có đúng không chứ không nhầm đâu bạn ạ.
 
Upvote 0
@ ChanhTQ@ Theo đề bài tôi hiểu
- Tìm cell cuối cùng có data chứ không phải là LastCell vì chưa chắc LastCell có Data
- và khóa từ đó trở về trước, các vùng khác không có data thì vẫn được edit bình thường. Có nghĩa là chỉ khoá vùng có Data validation mà thôi.

Không biết Tôi hiểu như vậy có đúng không chứ không nhầm đâu bạn ạ.
Nhưng anh ơi... có Data cũng chưa hẳn nó là Validation mà anh ---> Cell cuối cùng là cell nhập liệu bình thường cũng được vậy
(Hay là em chưa hiểu ý anh nhỉ?)
 
Upvote 0
cảm ơn mọi người đã giúp đỡ.
data ở đây có ý là dữ liệu mà ta nhập vào.
vd bắt đầu từ A2 ta nhập dữ liệu đến D8 thì vùng A2:D8 bị khóa lại.còn các nơi khác vẫn bình thường(vẫn xóa,chèn được)
 
Upvote 0
Bạn thử code này xem có được không ?

Mã:
Sub Locked_Data()
  ActiveSheet.Unprotect
  Dim UsRng As Range, i As Long
  With Cells.SpecialCells(2)
    Set UsRng = .Areas(1)
    For i = 1 To .Areas.Count
      Set UsRng = Range(UsRng, .Areas(i))
    Next i
    UsRng.Locked = True
  End With
    ActiveSheet.Protect
End Sub
 
Lần chỉnh sửa cuối:
Upvote 0
thank trung chinh.
mình thử đoạn code của anh rồi nhưng sao nó có tác động cả sheet luôn, tức là ở các cell trống khác vẫn báo bị protect và dòng, cột bị mất 1 số quyền làm việc với nó(như chèn, xóa ..).
Mong anh xem lại giúp mình 1 tí.
 
Upvote 0
cảm ơn mọi người đã giúp đỡ.
data ở đây có ý là dữ liệu mà ta nhập vào.
vd bắt đầu từ A2 ta nhập dữ liệu đến D8 thì vùng A2:D8 bị khóa lại.còn các nơi khác vẫn bình thường(vẫn xóa,chèn được)

1. Vậy ý của bạn là chỉ khoá những ô có dữ liệu hay khoá cả vùng dữ liệu (vùng dữ liệu là vùng được giới hạn bởi ô đầu và ô cuối có dữ liệu, trong vùng có thể có những ô không có dữ liệu). Theo bạn viết ở trên là khoá cả vùng dữ liệu. Bạn kiểm tra lại bằng cách bôi đen toàn bộ các dòng, cột có dữ liệu, tất cả những ô nằm trong vùng hình chữ nhật này là những ô bị khoá còn các ô nằm ngoài vùng này vẫn nhập dữ liệu được bình thường.
2. Đối với các Sheet bị khoá thì không thể chèn hoặc thêm dòng, cột được bạn ạ.
 
Upvote 0
Cảm ơn bạn. mình đã thử rồi nhưng với ô trống thì nhập vào bị thông báo " the cell ...."
Còn ý của mình đưa ra là mình có vùng dữ liệu vd từ A2:D8, mình không cho người khác chỉnh sửa trong đó.Nhưng khi mình nhập tiếp dữ liệu vào từ dòng A9 thì vùng mới là A9:D9 được tự động (hay chạy nút lệnh gì đó ) khóa lại.
Mong bạn giúp đỡ.
 
Upvote 0
Xin lỗi bạn khi nãy tôi không test lại, code trước thiếu 1 dòng tôi đã sửa lại (dòng màu đỏ). Bạn thử lại nhé.
Mã:
Sub Locked_Data()
  ActiveSheet.Unprotect
  [COLOR=Red]Cells.Locked = False[/COLOR]
  Dim UsRng As Range, i As Long
  With Cells.SpecialCells(2)
    Set UsRng = .Areas(1)
    For i = 1 To .Areas.Count
      Set UsRng = Range(UsRng, .Areas(i))
    Next i
    UsRng.Locked = True
  End With
    ActiveSheet.Protect
End Sub
Còn nếu bạn muốn tự động khoá ngay sau khi nhập liệu thì Pate code này vào Module sheet
Mã:
Private Sub Worksheet_Change(ByVal Target As Range)
  ActiveSheet.Unprotect
  Cells.Locked = False
  Dim UsRng As Range, i As Long
  With Cells.SpecialCells(2)
    Set UsRng = .Areas(1)
    For i = 1 To .Areas.Count
      Set UsRng = Range(UsRng, .Areas(i))
    Next i
    UsRng.Locked = True
  End With
    ActiveSheet.Protect
End Sub
 
Lần chỉnh sửa cuối:
Upvote 0
Web KT

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

Back
Top Bottom