Nhập dữ liệu và tự khóa (1 người xem)

keke355992 · 10/7/12

Yêu cầu mình đã viết trong file, xin chân thành cảm ơn

Quang_Hải · 10/7/12

Bạn thay code này vào nghen, chỉ khóa tới ô AV12 , nếu muốn thì thay AV12 theo thực tế nhé

PHP:

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim cell
If Not Intersect(Target, [E7:F700]) Is Nothing Then
    If Target.Rows.Count = 1 And Target.Columns.Count = 1 Then
        If Target.Value = "x" Then
            ActiveSheet.Unprotect "123"
            Target.Offset(, -2).Value = Now()
            Target.Locked = True
            Target.Offset(, -2).Locked = True
            ActiveSheet.Protect "123", DrawingObjects:=True, Contents:=True, Scenarios:=True _
            , AllowFormattingCells:=True, AllowFormattingColumns:=True, _
            AllowFormattingRows:=True
            ActiveSheet.EnableSelection = xlUnlockedCells
        End If
    End If
End If
If Not Intersect(Target, [H7:AV12]) Is Nothing Then
ActiveSheet.Unprotect "123"
For Each cell In [H7:AV12]
    If cell.Value <> "" Then cell.Locked = True
Next cell
ActiveSheet.Protect "123"
End If
End Sub

keke355992 · 10/7/12

quanghai1969 đã viết:

Bạn thay code này vào nghen, chỉ khóa tới ô AV12 , nếu muốn thì thay AV12 theo thực tế nhé

PHP:

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim cell
If Not Intersect(Target, [E7:F700]) Is Nothing Then
    If Target.Rows.Count = 1 And Target.Columns.Count = 1 Then
        If Target.Value = "x" Then
            ActiveSheet.Unprotect "123"
            Target.Offset(, -2).Value = Now()
            Target.Locked = True
            Target.Offset(, -2).Locked = True
            ActiveSheet.Protect "123", DrawingObjects:=True, Contents:=True, Scenarios:=True _
            , AllowFormattingCells:=True, AllowFormattingColumns:=True, _
            AllowFormattingRows:=True
            ActiveSheet.EnableSelection = xlUnlockedCells
        End If
    End If
End If
If Not Intersect(Target, [H7:AV12]) Is Nothing Then
ActiveSheet.Unprotect "123"
For Each cell In [H7:AV12]
    If cell.Value <> "" Then cell.Locked = True
Next cell
ActiveSheet.Protect "123"
End If
End Sub

[/QUOTE
Bạn ơi dữ liệu của mình đến dòng 650, mình thay thành [H7:AV650] thì báo lỗi "run time error 1004" bạn ah, bạn sửa giùm mình với

Quang_Hải · 10/7/12

Mình đã thay code và kiểm tra thấy code không có lỗi, không biết là lỗi nằm chỗ nào. Nếu vẫn chưa ổ thì up file bị lỗi lên nha.

PHP:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim cell
If Not Intersect(Target, [E7:F650]) Is Nothing Then
    If Target.Rows.Count = 1 And Target.Columns.Count = 1 Then
        If Target.Value = "x" Then
            ActiveSheet.Unprotect "123"
            Target.Offset(, -2).Value = Now()
            Target.Locked = True
            Target.Offset(, -2).Locked = True
            ActiveSheet.Protect "123", DrawingObjects:=True, Contents:=True, Scenarios:=True _
            , AllowFormattingCells:=True, AllowFormattingColumns:=True, _
            AllowFormattingRows:=True
            ActiveSheet.EnableSelection = xlUnlockedCells
        End If
    End If
End If
If Not Intersect(Target, [H7:AV650]) Is Nothing Then
ActiveSheet.Unprotect "123"
For Each cell In [H7:AV650]
    If cell.Value <> "" Then cell.Locked = True
Next cell
ActiveSheet.Protect "123"
End If
End Sub

Ba Tê · 10/7/12

quanghai1969 đã viết:

Mình đã thay code và kiểm tra thấy code không có lỗi, không biết là lỗi nằm chỗ nào. Nếu vẫn chưa ổ thì up file bị lỗi lên nha.

PHP:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim cell
If Not Intersect(Target, [E7:F650]) Is Nothing Then
    If Target.Rows.Count = 1 And Target.Columns.Count = 1 Then
        If Target.Value = "x" Then
            ActiveSheet.Unprotect "123"
            Target.Offset(, -2).Value = Now()
            Target.Locked = True
            Target.Offset(, -2).Locked = True
            ActiveSheet.Protect "123", DrawingObjects:=True, Contents:=True, Scenarios:=True _
            , AllowFormattingCells:=True, AllowFormattingColumns:=True, _
            AllowFormattingRows:=True
            ActiveSheet.EnableSelection = xlUnlockedCells
        End If
    End If
End If
If Not Intersect(Target, [H7:AV650]) Is Nothing Then
ActiveSheet.Unprotect "123"
For Each cell In [H7:AV650]
    If cell.Value <> "" Then cell.Locked = True
Next cell
ActiveSheet.Protect "123"
End If
End Sub

Mỗi lần nhập liệu vào vùng H7:AV650 lại duyệt hết từng Cell sao phí vậy.
Thử như vầy xem:

PHP:

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, [E7:F700]) Is Nothing Then
    If Target.Rows.Count = 1 And Target.Columns.Count = 1 Then
        If Target.Value = "x" Then
            ActiveSheet.Unprotect "123"
                        Target.Offset(, -2).Value = Now()
                    Target.Locked = True
                Target.Offset(, -2).Locked = True
            ActiveSheet.Protect "123"
        End If
    End If
ElseIf Not Intersect(Target, [H7:AV700]) Is Nothing Then
    If Target.Rows.Count = 1 And Target.Columns.Count = 1 Then
        If Target.Value <> "" Then
            ActiveSheet.Unprotect "123"
                    Target.Locked = True
            ActiveSheet.Protect "123"
        End If
    End If
End If
End Sub

Quang_Hải · 10/7/12

Ba Tê đã viết:
Mỗi lần nhập liệu vào vùng H7:AV650 lại duyệt hết từng Cell sao phí vậy.

Đúng rồi em xài phí quá, em viết theo quán tính mà quên nhìn rộng hơn. Đúng là kinh nghiệm của em còn quá ít.

keke355992 · 10/7/12

Cùng một bảng tính mà thay code của bác Ba tê vào thì chạy OK nhưng của bác quanghai vẫn bị báo lỗi 1004 khi mình thay đổi code thanh H7:AV650 , hiz mù tịt VBA nên cũng k bít vì sao luôn. Rất Cảm ơn và chúc 2 bác ngủ ngon nha ^^

keke355992 · 14/7/12

Ba Tê đã viết:

Mỗi lần nhập liệu vào vùng H7:AV650 lại duyệt hết từng Cell sao phí vậy.
Thử như vầy xem:

PHP:

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, [E7:F700]) Is Nothing Then
    If Target.Rows.Count = 1 And Target.Columns.Count = 1 Then
        If Target.Value = "x" Then
            ActiveSheet.Unprotect "123"
                        Target.Offset(, -2).Value = Now()
                    Target.Locked = True
                Target.Offset(, -2).Locked = True
            ActiveSheet.Protect "123"
        End If
    End If
ElseIf Not Intersect(Target, [H7:AV700]) Is Nothing Then
    If Target.Rows.Count = 1 And Target.Columns.Count = 1 Then
        If Target.Value <> "" Then
            ActiveSheet.Unprotect "123"
                    Target.Locked = True
            ActiveSheet.Protect "123"
        End If
    End If
End If
End Sub

Nhờ bác giúp mình chèn đoan code tự động save bảng tỉnh sau khi thực hiện một trong những thao tác này với ^^

hoangvuluan · 14/7/12

keke355992 đã viết:
Nhờ bác giúp mình chèn đoan code tự động save bảng tỉnh sau khi thực hiện một trong những thao tác này với ^^

Chèn thêm code sau dưới mỗi câu lệnh: ActiveSheet.Protect "123"

ThisWorkBook.Save

keke355992 · 15/7/12

hoangvuluan đã viết:
Chèn thêm code sau dưới mỗi câu lệnh: ActiveSheet.Protect "123"

ThisWorkBook.Save

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, [E7:F700]) Is Nothing Then
If Target.Rows.Count = 1 And Target.Columns.Count = 1 Then
If Target.Value = "x" Then
ActiveSheet.Unprotect "123"
Target.Offset(, -2).Value = Now()
Target.Locked = True
Target.Offset(, -2).Locked = True
ActiveSheet.Protect "123"
ThisWorkBook.Save
End If
End If
ElseIf Not Intersect(Target, [H7:AV700]) Is Nothing Then
If Target.Rows.Count = 1 And Target.Columns.Count = 1 Then
If Target.Value <> "" Then
ActiveSheet.Unprotect "123"
Target.Locked = True
ActiveSheet.Protect "123"
ThisWorkBook.Save
End If
End If
End If
End Sub

Như thế này đúng chưa bạn

Quang_Hải · 15/7/12

Minh nghĩ chỉ cần save một lần trước câu End Sub là đủ rồi

Nhập dữ liệu và tự khóa (1 người xem)

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

keke355992

Thành viên thường trực

File đính kèm

Quang_Hải

Thành viên gạo cội

keke355992

Thành viên thường trực

Quang_Hải

Thành viên gạo cội

Ba Tê

Cạo Rồi Khỏi Gội

Quang_Hải

Thành viên gạo cội

keke355992

Thành viên thường trực

keke355992

Thành viên thường trực

hoangvuluan

Thành viên tích cực

keke355992

Thành viên thường trực

Quang_Hải

Thành viên gạo cội

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

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Đếm ngược thời gian