Khóa cell theo điều kiện

[lp0042019.dkdn]

Chào các anh/chị,

Nhờ các anh chị viết giúp em VBA để khóa những cell tương ứng với thời gian ngày đến và ngày đi nhưng không dùng Validation,cảm ơn các anh chị.

 

[Maika8008]

Chào các anh/chị,

Nhờ các anh chị viết giúp em VBA để khóa những cell tương ứng với thời gian ngày đến và ngày đi nhưng không dùng Validation,cảm ơn các anh chị.

Sub KhoaCell()
Dim i As Long, FD As Long, LD As Long

    For i = 8 To Range("B8").End(xlDown).Row
        FD = Day(Range("B" & i)): LD = Day(Range("C" & i))
        ActiveSheet.Range(Cells(i, FD + 4), Cells(i, LD + 4)).Locked = False
    Next
    ActiveSheet.Protect Password:="123", DrawingObjects:=True, Contents:=True, Scenarios:=True
End Sub

 

[lp0042019.dkdn]

Sub KhoaCell()
Dim i As Long, FD As Long, LD As Long

    For i = 8 To Range("B8").End(xlDown).Row
        FD = Day(Range("B" & i)): LD = Day(Range("C" & i))
        ActiveSheet.Range(Cells(i, FD + 4), Cells(i, LD + 4)).Locked = False
    Next
    ActiveSheet.Protect Password:="123", DrawingObjects:=True, Contents:=True, Scenarios:=True
End Sub

Trường hợp ngày đến và ngày đi thay đổi , bạn giúp mình code xóa những dữ liệu đã có nằm ngoài vùng cho nhập liệu mới (chỉ thực hiện dòng nào thay đổi so với lúc ban đầu). Cảm ơn bạn.

 

[Maika8008]

Trường hợp ngày đến và ngày đi thay đổi , bạn giúp mình code xóa những dữ liệu đã có nằm ngoài vùng cho nhập liệu mới (chỉ thực hiện dòng nào thay đổi so với lúc ban đầu). Cảm ơn bạn.

Bạn xem thử: đây là thủ tục dùng chỉnh sửa sau khi đã chạy thủ tục KhoaCell nhằm xóa data của các cell nằm ngoài vùng mới, đồng thời khóa chúng lại, thực hiện cho tất cả các dòng dù có thay đổi hay không.

Ghi chú: Tôi thêm vào ngày 31, kẻo khi gặp tháng 31 ngày lại thiếu

Sub KhoaCell_ThayDoi()
Dim i As Long, FD As Long, LD As Long

    ActiveSheet.Unprotect Password:="123"
   
    For i = 8 To Range("B8").End(xlDown).Row
   
        FD = Day(Range("B" & i)): LD = Day(Range("C" & i))
        ActiveSheet.Range(Cells(i, FD + 4), Cells(i, LD + 4)).Locked = False
       
        With ActiveSheet.Range(Cells(i, 5), Cells(i, FD + 3))
            .Locked = True
            .ClearContents
        End With
       
        With ActiveSheet.Range(Cells(i, LD + 5), Cells(i, 35))
            .Locked = True
            .ClearContents
        End With
       
    Next
   
    ActiveSheet.Protect Password:="123", DrawingObjects:=True, Contents:=True, Scenarios:=True

End Sub