Không cho Delete dòng theo điều kiện

Liên hệ QC
Tôi tuân thủ nội quy khi đăng bài
Có
L

LanAnh19

Thành viên chính thức
Tham gia
1/5/22
Bài viết
76
Được thích
8
Giới tính
Nữ
Nhờ anh/chị giúp đỡ em như sau
Trong sheet DT Khi chọn những dòng mà có số liệu Phải Thu, Phải Trả - ở cột F, G (cụ thể dòng số 10 hay 11) hoặc chọn một khối dòng mà có dòng số 10 hay 11 trong đó thì Không thể Delete được (nhưng insert được)
Khi Delete thì có thông báo KHÔNG ĐƯỢC DELETE
Mục đích của em là không cho vô tình Delete các dòng có công nợ phải thu, phải trả
Không biết code có thể làm được không!? Em cảm ơn anh/chị
 

File đính kèm

  • Delete.xlsm
    9.7 KB · Đọc: 17
Sắp xếp theo thời gian sắp xếp theo bầu chọn
Bài này có cách nào không các bạn?
 
Upvote 0
Trong thời gian chờ đợi cao nhân thì thử bỏ code này trong sheet DT nhé

PHP: 
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rng As Range
    Dim cell As Range
    Dim intersectRange As Range
    Dim t As Integer
    Set intersectRange = Intersect(Target, Me.Range("F:G"))
    t = 1
    If Not intersectRange Is Nothing Then
        Application.EnableEvents = False
       
        For Each cell In intersectRange
            If cell.Cells.Count = 1 Then
                If cell.Value = "" Then
                    t = t + 1
                    Application.Undo
                End If
            End If
        Next cell
       
        If t > 1 Then MsgBox "Khong Duoc Xoa", vbExclamation, "Warning"
       
        Application.EnableEvents = True
    End If
End Sub
 

File đính kèm

  • Delete.xlsm
    11.1 KB · Đọc: 5
Upvote 0
heyhey1994 đã viết:
Trong thời gian chờ đợi cao nhân thì thử bỏ code này trong sheet DT nhé

PHP: 
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rng As Range
    Dim cell As Range
    Dim intersectRange As Range
    Dim t As Integer
    Set intersectRange = Intersect(Target, Me.Range("F:G"))
    t = 1
    If Not intersectRange Is Nothing Then
        Application.EnableEvents = False
      
        For Each cell In intersectRange
            If cell.Cells.Count = 1 Then
                If cell.Value = "" Then
                    t = t + 1
                    Application.Undo
                End If
            End If
        Next cell
      
        If t > 1 Then MsgBox "Khong Duoc Xoa", vbExclamation, "Warning"
      
        Application.EnableEvents = True
    End If
End Sub
Nhấp chuột vào đây để mở rộng...
Cảm ơn bạn nhiều, tuy nhiên code chỉ đáp ứng 1 phần như
1/ ví dụ ta chọn dòng số 10 mà delete thì xoá không được (đúng theo yêu cầu)
Nhưng nếu ta chọn dòng 11 mà delete thì xoá vẫn được, dù có hiện thông báo "khong duoc xoa"
hoặc chọn cụm dòng 10 và 11 hoặc cụm dòng 11 và 12 thì vẫn xoá được
Các bạn giúp điều chỉnh code giúp. Xin cảm ơn!
 

File đính kèm

  • Delete.xlsm
    13.7 KB · Đọc: 2
Upvote 0
heyhey1994 đã viết:
Trong thời gian chờ đợi cao nhân thì thử bỏ code này trong sheet DT nhé

PHP: 
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rng As Range
    Dim cell As Range
    Dim intersectRange As Range
    Dim t As Integer
    Set intersectRange = Intersect(Target, Me.Range("F:G"))
    t = 1
    If Not intersectRange Is Nothing Then
        Application.EnableEvents = False
      
        For Each cell In intersectRange
            If cell.Cells.Count = 1 Then
                If cell.Value = "" Then
                    t = t + 1
                    Application.Undo
                End If
            End If
        Next cell
      
        If t > 1 Then MsgBox "Khong Duoc Xoa", vbExclamation, "Warning"
      
        Application.EnableEvents = True
    End If
End Sub
Nhấp chuột vào đây để mở rộng...
Nó còn bị thêm 1 lỗi nữa là không cho insert dòng
nếu ví dụ ta chọn 1 dòng bất kỳ click right để insert thì nó không cho
 
Upvote 0
heyhey1994 đã viết:
Trong thời gian chờ đợi cao nhân thì thử bỏ code này trong sheet DT nhé

PHP: 
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rng As Range
    Dim cell As Range
    Dim intersectRange As Range
    Dim t As Integer
    Set intersectRange = Intersect(Target, Me.Range("F:G"))
    t = 1
    If Not intersectRange Is Nothing Then
        Application.EnableEvents = False
      
        For Each cell In intersectRange
            If cell.Cells.Count = 1 Then
                If cell.Value = "" Then
                    t = t + 1
                    Application.Undo
                End If
            End If
        Next cell
      
        If t > 1 Then MsgBox "Khong Duoc Xoa", vbExclamation, "Warning"
      
        Application.EnableEvents = True
    End If
End Sub
Nhấp chuột vào đây để mở rộng...
Code này chỉ dùng được trong trường hợp xóa giá trị chứ xóa dòng thì thua. Mà làm kiểu này nếu lỡ tay xóa cả cột thì chắc đợi đến mai.
 
Upvote 0
Định làm cho bạn mà mắc kẹt rồi.
Gợi ý cho bạn, trong selection, bạn xem nó có intersect với số liệu trong cột đó không?
Nếu có ít nhất 1 ô intersect, thì bạn can thiệp vào menu chuột phải, làm mờ control "Delete" đi, các chứng năng khác không thay đổi.
Application.commandbars("Cell").controls("Delete").enable=false
hay gì gì đấy mình chưa test đc.
Chiều rảnh nếu chưa làm đc mình thử xem.
 
Upvote 0
bebo021999 đã viết:
Định làm cho bạn mà mắc kẹt rồi.
Gợi ý cho bạn, trong selection, bạn xem nó có intersect với số liệu trong cột đó không?
Nếu có ít nhất 1 ô intersect, thì bạn can thiệp vào menu chuột phải, làm mờ control "Delete" đi, các chứng năng khác không thay đổi.
Application.commandbars("Cell").controls("Delete").enable=false
hay gì gì đấy mình chưa test đc.
Chiều rảnh nếu chưa làm đc mình thử xem.
Nhấp chuột vào đây để mở rộng...
Tôi toàn dùng phím tắt Ctrl + -
 
Upvote 0
bebo021999 đã viết:
Định làm cho bạn mà mắc kẹt rồi.
Gợi ý cho bạn, trong selection, bạn xem nó có intersect với số liệu trong cột đó không?
Nếu có ít nhất 1 ô intersect, thì bạn can thiệp vào menu chuột phải, làm mờ control "Delete" đi, các chứng năng khác không thay đổi.
Application.commandbars("Cell").controls("Delete").enable=false
hay gì gì đấy mình chưa test đc.
Chiều rảnh nếu chưa làm đc mình thử xem.
Nhấp chuột vào đây để mở rộng...
Em chỉ mày mò theo hướng này, vẫn chưa được
Mã: 
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Column = 6 And Target.Row > 8 Then
        If Target > 0 Then MsgBox "KHONG DUOC XOA"
    End If
End Sub
Còn theo hướng anh hướng dẫn
Application.commandbars("Cell").controls("Delete").enable=false
thì em bí
Khi nào anh rảnh thì giúp em nhé
 
Lần chỉnh sửa cuối:
Upvote 0
Dùng đỡ cách củ chuối này nhé. Code này đặt trong sheet module, sẽ bắt các sự kiện "Right Click"
Nếu bạn chọn cả dòng (hoặc nhiều dòng), chuột phải mà delete thì nó sẽ kiểm tra xem dòng đó có chưa số liệu trong cột F & H không
nếu có thì nó sẽ làm mờ nút "Delete" còn không thì vẫn bình thường.
Các chức năng khác ngoài "Delete" vẫn hoạt động bình thường.

PHP: 
Option Explicit
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
Dim lr&, cel As Range, u As Range
Dim ct As CommandBarControl, c As Boolean
lr = Cells(Rows.Count, "A").End(xlUp).Row
' kiem tra tung dong trong cot Phai thu và Phai tra, nau có so lieu thi tao union "u"
For Each cel In Range("F9:F" & lr)
    If (IsNumeric(cel) And cel > 0) Or (IsNumeric(cel.Offset(0, 1)) And cel.Offset(0, 1) > 0) Then
        If u Is Nothing Then
            Set u = cel
        Else
            Set u = Union(u, cel)
        End If
    End If
Next
c = Intersect(Target, u) Is Nothing ' kiem tra xem dong da chon co trung voi cac o trong union "u"  khong?
'neu dong chon co chua so o 2 cot Phai thu va Phai tra thi lam mo nut "Delete" di. (ID:=293 là nút delete)
For Each ct In Application.CommandBars.FindControls(ID:=293)
    ct.Enabled = c
Next ct
End Sub
 
Upvote 0
bebo021999 đã viết:
Dùng đỡ cách củ chuối này nhé. Code này đặt trong sheet module, sẽ bắt các sự kiện "Right Click"
Nếu bạn chọn cả dòng (hoặc nhiều dòng), chuột phải mà delete thì nó sẽ kiểm tra xem dòng đó có chưa số liệu trong cột F & H không
nếu có thì nó sẽ làm mờ nút "Delete" còn không thì vẫn bình thường.
Các chức năng khác ngoài "Delete" vẫn hoạt động bình thường.

PHP: 
Option Explicit
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
Dim lr&, cel As Range, u As Range
Dim ct As CommandBarControl, c As Boolean
lr = Cells(Rows.Count, "A").End(xlUp).Row
' kiem tra tung dong trong cot Phai thu và Phai tra, nau có so lieu thi tao union "u"
For Each cel In Range("F9:F" & lr)
    If (IsNumeric(cel) And cel > 0) Or (IsNumeric(cel.Offset(0, 1)) And cel.Offset(0, 1) > 0) Then
        If u Is Nothing Then
            Set u = cel
        Else
            Set u = Union(u, cel)
        End If
    End If
Next
c = Intersect(Target, u) Is Nothing ' kiem tra xem dong da chon co trung voi cac o trong union "u"  khong?
'neu dong chon co chua so o 2 cot Phai thu va Phai tra thi lam mo nut "Delete" di. (ID:=293 là nút delete)
For Each ct In Application.CommandBars.FindControls(ID:=293)
    ct.Enabled = c
Next ct
End Sub
Nhấp chuột vào đây để mở rộng...
Quá tuyệt anh ạ. Xin cảm ơn anh nhiều!
 
Upvote 0
bebo021999 đã viết:
Dùng đỡ cách củ chuối này nhé. Code này đặt trong sheet module, sẽ bắt các sự kiện "Right Click"
Nếu bạn chọn cả dòng (hoặc nhiều dòng), chuột phải mà delete thì nó sẽ kiểm tra xem dòng đó có chưa số liệu trong cột F & H không
nếu có thì nó sẽ làm mờ nút "Delete" còn không thì vẫn bình thường.
Các chức năng khác ngoài "Delete" vẫn hoạt động bình thường.

PHP: 
Option Explicit
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
Dim lr&, cel As Range, u As Range
Dim ct As CommandBarControl, c As Boolean
lr = Cells(Rows.Count, "A").End(xlUp).Row
' kiem tra tung dong trong cot Phai thu và Phai tra, nau có so lieu thi tao union "u"
For Each cel In Range("F9:F" & lr)
    If (IsNumeric(cel) And cel > 0) Or (IsNumeric(cel.Offset(0, 1)) And cel.Offset(0, 1) > 0) Then
        If u Is Nothing Then
            Set u = cel
        Else
            Set u = Union(u, cel)
        End If
    End If
Next
c = Intersect(Target, u) Is Nothing ' kiem tra xem dong da chon co trung voi cac o trong union "u"  khong?
'neu dong chon co chua so o 2 cot Phai thu va Phai tra thi lam mo nut "Delete" di. (ID:=293 là nút delete)
For Each ct In Application.CommandBars.FindControls(ID:=293)
    ct.Enabled = c
Next ct
End Sub
Nhấp chuột vào đây để mở rộng...
bebo021999 đã viết:
Dùng đỡ cách củ chuối này nhé. Code này đặt trong sheet module, sẽ bắt các sự kiện "Right Click"
Nếu bạn chọn cả dòng (hoặc nhiều dòng), chuột phải mà delete thì nó sẽ kiểm tra xem dòng đó có chưa số liệu trong cột F & H không
nếu có thì nó sẽ làm mờ nút "Delete" còn không thì vẫn bình thường.
Các chức năng khác ngoài "Delete" vẫn hoạt động bình thường.

PHP: 
Option Explicit
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
Dim lr&, cel As Range, u As Range
Dim ct As CommandBarControl, c As Boolean
lr = Cells(Rows.Count, "A").End(xlUp).Row
' kiem tra tung dong trong cot Phai thu và Phai tra, nau có so lieu thi tao union "u"
For Each cel In Range("F9:F" & lr)
    If (IsNumeric(cel) And cel > 0) Or (IsNumeric(cel.Offset(0, 1)) And cel.Offset(0, 1) > 0) Then
        If u Is Nothing Then
            Set u = cel
        Else
            Set u = Union(u, cel)
        End If
    End If
Next
c = Intersect(Target, u) Is Nothing ' kiem tra xem dong da chon co trung voi cac o trong union "u"  khong?
'neu dong chon co chua so o 2 cot Phai thu va Phai tra thi lam mo nut "Delete" di. (ID:=293 là nút delete)
For Each ct In Application.CommandBars.FindControls(ID:=293)
    ct.Enabled = c
Next ct
End Sub
Nhấp chuột vào đây để mở rộng...
Anh ơi, nó còn bị 1 lỗi nhỏ như sau
Trường hợp mà bảng cột Phải thu, Phải trả mà không có số liệu, nếu em Right click để Insert hay làm gì đó thì nó báo lỗi như hình
báo lỗi ở dòng
c = Intersect(Target, u) Is Nothing ' kiem tra xem dong da chon co trung voi cac o trong union "u" khong?
Em có thêm dòng On Error Resume Next thì không được
Nhờ anh bẫy lỗi giúp em. Xin cảm ơn!
 

File đính kèm

  • LoiLoi.png
    LoiLoi.png
    19.6 KB · Đọc: 6
  • Delete.xlsm
    17.8 KB · Đọc: 2
Upvote 0
LanAnh19 đã viết:
Anh ơi, nó còn bị 1 lỗi nhỏ như sau
Trường hợp mà bảng cột Phải thu, Phải trả mà không có số liệu, nếu em Right click để Insert hay làm gì đó thì nó báo lỗi như hình
báo lỗi ở dòng
c = Intersect(Target, u) Is Nothing ' kiem tra xem dong da chon co trung voi cac o trong union "u" khong?
Em có thêm dòng On Error Resume Next thì không được
Nhờ anh bẫy lỗi giúp em. Xin cảm ơn!
Nhấp chuột vào đây để mở rộng...
OK. Vì lúc này Union u không có cell nào trong đó.
Thêm dòng này nhé
Mã: 
......
Next
If u Is Nothing Then Exit Sub ' dòng mới thêm vào
c = Intersect(Target, u) Is Nothing
....
 
Upvote 0
bebo021999 đã viết:
OK. Vì lúc này Union u không có cell nào trong đó.
Thêm dòng này nhé
Mã: 
......
Next
If u Is Nothing Then Exit Sub ' dòng mới thêm vào
c = Intersect(Target, u) Is Nothing
....
Nhấp chuột vào đây để mở rộng...
Các anh /chị xem giúp em
Hình như sự kiện Private Sub Worksheet_BeforeRightClick không tự làm mới (tự update) thì phải
Cụ thể, từ file đính kèm nếu ta Right click vào dòng số 10 thì menu hiện ra nhưng mục Delete thì mờ đi (mặc dù cột F hay G không có số liệu - như hình đính kèm)
Hoặc thử nghiệm cách khác
Tại ô F10 ta nhập thử số 1, ta chọn dòng số 10 rồi Right click thì mục Delete bị mờ (code chạy đúng)
bi giờ nếu ta xoá số 1 ở ô F10 rồi Right click dòng số 10 thì mục Delete vẫn bị mờ (sai)
Theo em thì sự kiện Private Sub Worksheet_BeforeRightClick không tự làm mới (tự update)
Anh/ chị giúp em để nó tự cập nhật được nhé
Em có thêm, nhưng cũng không được
Application.EnableEvents = False
Application.ScreenUpdating = False
.....
Em cảm ơn!
 

File đính kèm

  • Loi-1.png
    Loi-1.png
    161.7 KB · Đọc: 4
  • Delete-3.xlsm
    18.3 KB · Đọc: 5
Upvote 0
OK. Chỉnh 1 chút. Ngay đầu sub, sau phần khai báo biến, mình cho nó mặc định nổi chữ "delete" lên trước nhé, sau đó phía dưới mới xét điều kiện.
PHP: 
For Each ct In Application.CommandBars.FindControls(ID:=293)
    ct.Enabled = True
Next ct
..........................
 
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

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

O
  • Question
Tìm số thứ tự của sheet trong workbook có nhiều sheets
Trả lời
13
Đọc
3K
Hoàng Tuấn 868
H
H
  • Question
Xóa toàn bộ các dòng giống nhau ở 1 cột
    • Cười
Trả lời
13
Đọc
108
SA_DQ
SA_DQ
S
Hỏi cách nhập dữ liệu vào 1 ô trả kết quả ở 1 ô khác có công thức
Trả lời
9
Đọc
171
Hoàng Tuấn 868
H
pingping2288
Lỗi cứ lần mở lại file excel là font chữ và định dạng ô lại thay đổi
Trả lời
14
Đọc
142
Hoàng Tuấn 868
H
vova2209
  • Question
Tìm địa chỉ ô với 2đk và chuyển thành links
Trả lời
14
Đọc
244
vova2209
vova2209
ongke0711
  • Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba
    • Thích
    • Yêu thích
7 8 9
Trả lời
164
Đọc
8K
chstbcaolanh
C
T
Đánh Số Thứ Tự Loại Bỏ Trùng
Trả lời
1
Đọc
42
bebo021999
B
H
Có thể mở file Excel mới sẽ Zoom mặc định 150% không?
Trả lời
4
Đọc
173
VetMini
V
Manhhung90
Liệt kê các ngày cộng dồn mong muốn vào 1 ô. Nhờ mọi người giúp mình ạ.
2 3 4
Trả lời
62
Đọc
760
VetMini
V
C
Hàm đánh số thứ tự như không đánh dữ liệu trùng
Trả lời
7
Đọc
8K
Trang Tuyet Ngoc Nhi
T
Hai Lúa Miền Tây
  • Question
Hàm chuyển dữ liệu từ cột sang dòng (Hàm melt + wide_to_long của Python trong Excel)
    • Thích
    • Cảm ơn
    • Yêu thích
Trả lời
9
Đọc
475
tranhungdao12a3
T
GPE-Trợ Lý
Đăng ký tham dự hội thảo tại Hà Nội: Power Query - Công cụ quản lý dữ liệu
    • Thích
    • Yêu thích
    • Cảm ơn
Trả lời
4
Đọc
475
PhanTuHuong
PhanTuHuong
tvcneo
  • Question
Nhờ Anh Chị Em giúp mình cách để tạo macro giống như trong file này
Trả lời
17
Đọc
235
huuthang_bd
huuthang_bd
T
Có phải lỗi Excel?
Trả lời
8
Đọc
9K
dinhthang8709
D
T
Công thức lấy dữ liệu
Trả lời
3
Đọc
127
HUONGHCKT
H
S
  • Question
Nhờ anh chị giúp em hàm ngẫu nhiên với tổng là 1 số
Trả lời
6
Đọc
154
SA_DQ
SA_DQ
L
Tự động nhảy số tham chiếu khi sang sheet mới
Trả lời
5
Đọc
5K
Romantic92
R
TieuLong2708
Danh sách lịch cắt người trực
Trả lời
0
Đọc
39
TieuLong2708
TieuLong2708
C
  • Question
Xin giúp đỡ Code kiểm tra và copy dữ liệu từ sheet 1 sang sheet 2
2
Trả lời
21
Đọc
633
conan1
C
H
  • Question
Mong giúp code chuyển file xls sang xlsx hàng loạt và không lỗi số liệu
Trả lời
16
Đọc
381
Hoàng Tuấn 868
H
Xem thêm…

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

Back
Top Bottom