Giúp code xóa dòng tự đưa dữ liệu hàng dưới lên (1 người xem)

[minhtuan55]

Chào cả nhà GPE !
Em muốn dùng 1 đoạn code thì khi e Click phải vào dòng nào ( Vùng A220 ) thì hiện lên 1 bảng thông báo Bạn có muốn xóa không, chọn Ok thì dòng đó sẽ xóa ( Range("a" & i, "d" & i).ClearContents ). và sau khi xóa xong thì các dòng bên dưới tự nâng lên.
Ví dụ: em click phải vào hàng số 7 em chọn Ok thì A77 sẽ ClearContents và sau khi xóa xong thì các dòng bên dưới ( A88 - đến A2020 ) tự nâng lên.
Code thì em làm được phần xóa, còn phần tự nâng lên cho không thấy khoảng trắng sau khi xóa thì em không biết. kính mong mọi người giúp đở. em xin chân thành cảm ơn

 

[giaiphap]

Chào cả nhà GPE !
Em muốn dùng 1 đoạn code thì khi e Click phải vào dòng nào ( Vùng A220 ) thì hiện lên 1 bảng thông báo Bạn có muốn xóa không, chọn Ok thì dòng đó sẽ xóa ( Range("a" & i, "d" & i).ClearContents ). và sau khi xóa xong thì các dòng bên dưới tự nâng lên.
Ví dụ: em click phải vào hàng số 7 em chọn Ok thì A77 sẽ ClearContents và sau khi xóa xong thì các dòng bên dưới ( A88 - đến A2020 ) tự nâng lên.
Code thì em làm được phần xóa, còn phần tự nâng lên cho không thấy khoảng trắng sau khi xóa thì em không biết. kính mong mọi người giúp đở. em xin chân thành cảm ơn

Cũng chính đoạn code của bạn, thêm vào chổ màu đỏ thử xem đúng yêu cầu chưa.

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)


If Not Intersect(Target, Range("A2:D20")) Is Nothing Then
    Cancel = True
    Dim i As Long
    i = Selection.Row
    
    If MsgBox("Xoa dong nay?", 4) = 6 Then
        [COLOR=#ff0000][B]'[/B][/COLOR]Range("a" & i, "d" & i).ClearContents
[COLOR=#ff0000][B]          Range("A" & (i + 1), "D20").Copy Range("a" & i)[/B][/COLOR]
    End If
    
End If
End Sub

 

[minhtuan55]

Thank a . Code của a chỉ đúng khi em nhập thiếu dữ liệu. E vừa nhập đầy đủ dữ liệu từ A220 thì sau khi e xóa nó dòng cuối bị lỗi. E có gửi File anh thừ a xóa dòng số 10 xem và a để để ý 2 dòng cuối nó bị lỗi

Cũng chính đoạn code của bạn, thêm vào chổ màu đỏ thử xem đúng yêu cầu chưa.

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)


If Not Intersect(Target, Range("A2:D20")) Is Nothing Then
    Cancel = True
    Dim i As Long
    i = Selection.Row
    
    If MsgBox("Xoa dong nay?", 4) = 6 Then
       Range("a" & i, "d" & i).ClearContents
[COLOR=#ff0000][B]       Range("A" & (i + 1), "D20").Copy Range("a" & i)[/B][/COLOR]
    End If
    
End If
End Sub

 

[giaiphap]

Vậy sửa thế này vậy

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)


If Not Intersect(Target, Range("A2:D20")) Is Nothing Then
    Cancel = True
    Dim i As Long
    i = Selection.Row
    
    If MsgBox("Xoa dong nay?", 4) = 6 Then
[COLOR=#ff0000][B]       Range("A" & (i + 1), "D20").Copy Range("a" & i)[/B][/COLOR]
[COLOR=#ff0000][B]       Range("a20:d20").ClearContents[/B][/COLOR]
    End If
    
End If
End Sub

 

[minhtuan55]

Vậy sửa thế này vậy

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)


If Not Intersect(Target, Range("A2:D20")) Is Nothing Then
    Cancel = True
    Dim i As Long
    i = Selection.Row
    
    If MsgBox("Xoa dong nay?", 4) = 6 Then
[COLOR=#ff0000][B]       Range("A" & (i + 1), "D20").Copy Range("a" & i)[/B][/COLOR]
[COLOR=#ff0000][B]       Range("a20:d20").ClearContents[/B][/COLOR]
    End If
    
End If
End Sub

Tuyệt vời. Thank a . vậy mà e nghỉ không ra. giờ đọc code của a e mới hiểu

 

[giaiphap]

Tuyệt vời. Thank a . vậy mà e nghỉ không ra. giờ đọc code của a e mới hiểu

Bạn xem kỷ lại chút, cái đoạn code này chỉ cho phép xóa 1 dòng thôi. Giả sử chọn 3 dòng cùng lúc và chọn lệnh xóa thì thế nào đây? Bạn thử đoạn code này xem thế nào? Chọn thử 2 hay 3 dòng liên tiếp và chọn xóa thử thế nào.

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)


If Not Intersect(Target, Range("A2:D20")) Is Nothing Then
    Cancel = True
    Dim i As Long
    i = Selection.Row
    If MsgBox("Xoa dong nay?", 4) = 6 Then
       Range("A" & (i + Selection.Rows.Count) & ":D20").Copy Range("a" & i)
       Range("A" & (21 - Selection.Rows.Count) & ":D20").ClearContents
    End If
End If
End Sub

 

[minhtuan55]

Bạn xem kỷ lại chút, cái đoạn code này chỉ cho phép xóa 1 dòng thôi. Giả sử chọn 3 dòng cùng lúc và chọn lệnh xóa thì thế nào đây? Bạn thử đoạn code này xem thế nào? Chọn thử 2 hay 3 dòng liên tiếp và chọn xóa thử thế nào.

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)


If Not Intersect(Target, Range("A2:D20")) Is Nothing Then
    Cancel = True
    Dim i As Long
    i = Selection.Row
    If MsgBox("Xoa dong nay?", 4) = 6 Then
       Range("A" & (i + Selection.Rows.Count) & ":D20").Copy Range("a" & i)
       Range("A" & (21 - Selection.Rows.Count) & ":D20").ClearContents
    End If
End If
End Sub

Code hay quá a,
Code hay quá a
Code hay quá a