Bài toán về khóa vùng dữ liệu bằng VBA

[yeuthamhangxom]

Gửi các anh chị GPE.
Em có câu hỏi về khóa vùng dữ liệu bằng VBA như file đính kèm nhờ các anh chị chỉ giúp.
Cám ơn các anh chị nhiều.

 

[yeuthamhangxom]

Xin chú ý thêm là không phải khóa vùng theo điều kiện là "màu" nha. Vì sợ các anh chị hiểu là khóa theo màu.
Rất mong các anh chị giúp đỡ.

 

[MinhNguyệt]

Gửi các anh chị GPE.
Em có câu hỏi về khóa vùng dữ liệu bằng VBA như file đính kèm nhờ các anh chị chỉ giúp.
Cám ơn các anh chị nhiều.

Hướng giải quyết :
1/ Lock toàn bộ các cells của Sheet2
2/ Protec Sheet2
3/ Tich nút nào thì Unprotec Sheet2 và Unlock các cells thuộc vùng đó
4/ Thực hiện xong thì làm lại thao tác của 1/ và 2/

 

[yeuthamhangxom]

Hướng giải quyết :
1/ Lock toàn bộ các cells của Sheet2
2/ Protec Sheet2
3/ Tich nút nào thì Unprotec Sheet2 và Unlock các cells thuộc vùng đó
4/ Thực hiện xong thì làm lại thao tác của 1/ và 2/

Viết bằng VBA thì câu lệnh như thế nào hả bạn Nguyệt. Giúp mình với.
Cám ơn bạn rất nhiều.

 

[hanhpptc]

Có phải bạn cần cái này không. Mình khoá (Protect) sheet2 với pass là 123, bạn có thể thay pass của mình trong Code

 

[yeuthamhangxom]

Có phải bạn cần cái này không. Mình khoá (Protect) sheet2 với pass là 123, bạn có thể thay pass của mình trong Code

Quá đúng với ý mình bạn hanhpptc ạ. Xin bạn hướng dẫn giúp mình code Application.ScreenUpdating = False mà bạn làm có nghĩa là gì?
Cám ơn bạn và mọi người đã giúp đỡ rất nhiều.

 

[hanhpptc]

câu lệnh: Application.ScreenUpdating = False/ True là để tắt hoặc mở chế độ nhấp nháy trung gian trên màn hình khi macro thực hiện các câu lệnh tương ứng

 

[yeuthamhangxom]

câu lệnh: Application.ScreenUpdating = False/ True là để tắt hoặc mở chế độ nhấp nháy trung gian trên màn hình khi macro thực hiện các câu lệnh tương ứng

Em đã hiểu thanks bạn hanhpptc nhiều nhiều.
Cám ơn banh hanhpptc và mọi người đã giúp đỡ.

 

[yeuthamhangxom]

câu lệnh: Application.ScreenUpdating = False/ True là để tắt hoặc mở chế độ nhấp nháy trung gian trên màn hình khi macro thực hiện các câu lệnh tương ứng

Bạn hanhpptc và mọi người ơi các bạn giúp mình thêm yêu cầu bổ xung này nhé. Yêu cầu về tự động chuyển dữ liệu sang sheet khác như file đính kèm
Cám ơn các bạn nhiều.

 

[ptlong04x1]

Bạn hanhpptc và mọi người ơi các bạn giúp mình thêm yêu cầu bổ xung này nhé. Yêu cầu về tự động chuyển dữ liệu sang sheet khác như file đính kèm
Cám ơn các bạn nhiều.

Mình làm lại bài này từ đầu như sau :

Module :

Sub LockRng(Rng As Range)
    Application.ScreenUpdating = False
    With Sheet2
        .Activate: .Unprotect ("123")
        Cells.Locked = True: Rng.Locked = False
        .Protect ("123"): Rng.Select
    End With
    Application.ScreenUpdating = True
End Sub

Sub RngA()
    Call LockRng(Sheet2.[c:g])
End Sub
Sub RngB()
    Call LockRng(Sheet2.[i:m])
End Sub
Sub RngC()
    Call LockRng(Sheet2.[o:s])
End Sub
Sub RngD()
    Call LockRng(Sheet2.[u:y])
End Sub
Sub RngE()
    Call LockRng(Sheet2.[aa:ae])
End Sub

Sheet2 :

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim ECll As Range
    If Intersect(Target, Union([g:g], [m:m], [s:s], [y:y], [ae:ae])) Is Nothing Or _
       WorksheetFunction.CountA(Target) = 0 Then Exit Sub
    Set ECll = Sheet3.[b1000].End(xlUp)(2)
    With Sheet3.Range(ECll.Address)
        .Resize(, 3) = Target(1, -3).Resize(, 3).Value
        .Offset(, 3) = Target
        .Offset(, 4) = "=rc[-2]*rc[-1]"
    End With
End Sub

 

[yeuthamhangxom]

Mình làm lại bài này từ đầu như sau :

[/PHP]Sheet2 :

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim ECll As Range
    If Intersect(Target, Union([g:g], [m:m], [s:s], [y:y], [ae:ae])) Is Nothing Or _
       WorksheetFunction.CountA(Target) = 0 Then Exit Sub
    Set ECll = Sheet3.[b1000].End(xlUp)(2)
    With Sheet3.Range(ECll.Address)
        .Resize(, 3) = Target(1, -3).Resize(, 3).Value
        .Offset(, 3) = Target
        .Offset(, 4) = "=rc[-2]*rc[-1]"
    End With
End Sub

Cám ơn bạn ptlong rất đúng ý mình. Vì mình mới học VBA nên chưa hiểu rõ code ở sheet2 mà bạn làm mong bạn giải thích giúp mình được không?
Cám ơn ptlong và các bạn đã nhiệt tình giúp đỡ.

 

[yeuthamhangxom]

Mình làm lại bài này từ đầu như sau :

Module :

Sub LockRng(Rng As Range)
    Application.ScreenUpdating = False
    With Sheet2
        .Activate: .Unprotect ("123")
        Cells.Locked = True: Rng.Locked = False
        .Protect ("123"): Rng.Select
    End With
    Application.ScreenUpdating = True
End Sub

Sub RngA()
    Call LockRng(Sheet2.[c:g])
End Sub
Sub RngB()
    Call LockRng(Sheet2.[i:m])
End Sub
Sub RngC()
    Call LockRng(Sheet2.[o:s])
End Sub
Sub RngD()
    Call LockRng(Sheet2.[u:y])
End Sub
Sub RngE()
    Call LockRng(Sheet2.[aa:ae])
End Sub

Sheet2 :

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim ECll As Range
    If Intersect(Target, Union([g:g], [m:m], [s:s], [y:y], [ae:ae])) Is Nothing Or _
       WorksheetFunction.CountA(Target) = 0 Then Exit Sub
    Set ECll = Sheet3.[b1000].End(xlUp)(2)
    With Sheet3.Range(ECll.Address)
        .Resize(, 3) = Target(1, -3).Resize(, 3).Value
        .Offset(, 3) = Target
        .Offset(, 4) = "=rc[-2]*rc[-1]"
    End With
End Sub

Bạn ptlong đã làm giúp mình và cũng đúng ý mình rồi. Nhưng mình chưa hiểu được các đoạn mã code. Có bạn nào biết xin giải thích từng hàng giúp mình được không? cứu cứu với.
Cám ơn các bạn nhiều.

 

[ptlong04x1]

Module :

1. Sub LockRng(Rng As Range)
     Application.ScreenUpdating = False
      With Sheet2
2.        .Activate: .Unprotect ("123")
3.       Cells.Locked = True: Rng.Locked = False
4.       .Protect ("123"): Rng.Select
    End With
    Application.ScreenUpdating = True
End Sub

5. Sub RngA()
6.     Call LockRng(Sheet2.[c:g])
    End Sub

Sheet2 :

7. Private Sub Worksheet_Change(ByVal Target As Range)
    Dim ECll As Range
8.    If Intersect(Target, Union([g:g], [m:m], [s:s], [y:y], [ae:ae])) Is Nothing Or _
       WorksheetFunction.CountA(Target) = 0 Then Exit Sub
9.    Set ECll = Sheet3.[b1000].End(xlUp)(2)
    With Sheet3.Range(ECll.Address)
10.        .Resize(, 3) = Target(1, -3).Resize(, 3).Value
11.         .Offset(, 3) = Target
12.        .Offset(, 4) = "=rc[-2]*rc[-1]"
    End With
End Sub

Module :

1. Tạo Sub LockRng (với tham số Rng được truyền vào, kiểu Range).

2. Kích hoạt Sheet2, mở khoá sheet với pass lá "123".

3. Khoá tất cả các cell, mở khoá vùng Rng (được truyền vào ở trên).

4. Khoá Sheet2 với pass : "123", chọn vùng Rng.

5. Tạo Sub RngA.

6. Gọi Sub LockRng truyền cho nó tham số Sheet2.[c:g] --> Rng nhận giá trị là vùng [C:G] của Sheet2.

Sheet2 :

7. Khi giá trị của ô hay vùng nào đó của sheet2 bị thay đổi (tham số Target sẽ nhận giá trị là ô hay vùng đó, tương tự như khi truyền giá trị cho Rng ở bước 6).

8. Nếu Target không giao với các vùng [g:g], [m:m] hay Target hoàn toàn rỗng (khi bạn xoá cả vùng dữ liệu ở [G:G] hay [M:M],... thì thoát Sub (không làm gì cả).

9. Gán biến ECll là ô kề dưới của ô cuối cùng có chứa dữ liệu trong cột B của Sheet3.

10, 11, 12. Gán giá trị cho vùng gồm 1 hàng, 3 cột bắt đầu từ ô ECll bằng giá trị của vùng tương ứng ở Sheet2, đoạn này hơi khó nói, lấy tạm 1 số ví dụ, ngẫm nghĩ 1 lúc sẽ thấy...có lý :

- Range("A1")(1,1) chính là ô A1.
- Range("A1")(1,2) chính là ô cùng hàng nhưng hơn ô A1 1 cột --> là ô B1.
- [C1] = "=rc[-2]*rc[-1]" --> Gán giá trị cho ô C1=A1*B1.
Với : r--> Row, c --> column, rc[-1] là ô kề bên trái của ô đang muốn gán giá trị, trong ví dụ là ô C1.

 

[concogia]

Gửi các anh chị GPE.
Em có câu hỏi về khóa vùng dữ liệu bằng VBA như file đính kèm nhờ các anh chị chỉ giúp.
Cám ơn các anh chị nhiều.

Nhân bài của bạn yeuthamhangxom mình có ý tưởng khóa các vùng đó mà không cần protect nhưng không làm được trực tiếp trên sheet mà phải dùng userform và một ô trung gian. Xin hỏi các cao thủ làm sao khóa các vùng đó bằng cách bấm trực tiếp như bài của bạn yeuthamhangxom trong bài đính kèm
Thân

 

[yeuthamhangxom]

Module :

1. Tạo Sub LockRng (với tham số Rng được truyền vào, kiểu Range).

2. Kích hoạt Sheet2, mở khoá sheet với pass lá "123".

3. Khoá tất cả các cell, mở khoá vùng Rng (được truyền vào ở trên).

4. Khoá Sheet2 với pass : "123", chọn vùng Rng.

5. Tạo Sub RngA.

6. Gọi Sub LockRng truyền cho nó tham số Sheet2.[c:g] --> Rng nhận giá trị là vùng [C:G] của Sheet2.

Sheet2 :

7. Khi giá trị của ô hay vùng nào đó của sheet2 bị thay đổi (tham số Target sẽ nhận giá trị là ô hay vùng đó, tương tự như khi truyền giá trị cho Rng ở bước 6).

8. Nếu Target không giao với các vùng [g:g], [m:m] hay Target hoàn toàn rỗng (khi bạn xoá cả vùng dữ liệu ở [G:G] hay [M:M],... thì thoát Sub (không làm gì cả).

9. Gán biến ECll là ô kề dưới của ô cuối cùng có chứa dữ liệu trong cột B của Sheet3.

10, 11, 12. Gán giá trị cho vùng gồm 1 hàng, 3 cột bắt đầu từ ô ECll bằng giá trị của vùng tương ứng ở Sheet2, đoạn này hơi khó nói, lấy tạm 1 số ví dụ, ngẫm nghĩ 1 lúc sẽ thấy...có lý :

- Range("A1")(1,1) chính là ô A1.
- Range("A1")(1,2) chính là ô cùng hàng nhưng hơn ô A1 1 cột --> là ô B1.
- [C1] = "=rc[-2]*rc[-1]" --> Gán giá trị cho ô C1=A1*B1.
Với : r--> Row, c --> column, rc[-1] là ô kề bên trái của ô đang muốn gán giá trị, trong ví dụ là ô C1.

Cám ơn bạn ptlong và các bạn đã nhiệt tình giúp đỡ.

 

[Duong gia]

Cám ơn bạn ptlong và các bạn đã nhiệt tình giúp đỡ.

Chào các bạn, mong các bạn giúp đỡ : mình muốn khóa từng dòng trong Excel với điều kiện sau: Bất cứ dòng nào mà cột F có chữ X thì macro sẽ khóa dữ liệu cả dòng đó, còn các dòng khác thì không. Cám ơn nhiều Mở file đính kèm ---> View attachment Khoa dong co Dieu kien.xls Thanks

 

[neyugngnort]

chào các bạn, mong giúp đỡ mình
Mình có bảng tính nhập dữ liệu hàng ngày, mình muốn bảo vệ dữ liệu đã nhập. Mình muốn khóa những ô nhập dữ liệu củ theo ngày hiện tại
Mình có đặt tên cho 1 vùng động bằng kết hợp offset và today() và đặt tên là " Lockcell"
Mình muốn mỗi khi bật file lên là những cell trong vùng Lockcell đó bị khóa
Mong các anh chị giúp đỡ, cảm ơn