Nhờ Anh chị diễn đàn giúp mình xem lỗi nằm ở đâu (4 người xem)

[ngothanhluan]

Nhờ mọi người xem giúp file, mình một code nhưng ở sheet 2 khi xóa 1 ô ở vùng màu vàng thì nó lại delete mất 2 dòng, còn ở sheet 3 thì chỉ có 1, anh chị xem giúp mình với.

 

[Hoàng Trọng Nghĩa]

Nhờ mọi người xem giúp file, mình một code nhưng ở sheet 2 khi xóa 1 ô ở vùng màu vàng thì nó lại delete mất 2 dòng, còn ở sheet 3 thì chỉ có 1, anh chị xem giúp mình với.

Bạn thử dùng code này xem:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim EmptyRange As Range, FindRange As Range
    Dim LastRow As Long
    LastRow = Range("D65536").End(xlUp).Row
    Set FindRange = Range("D8:D" & LastRow)
    If Not Intersect(FindRange, Target) Is Nothing Then
        Application.EnableEvents = False
        Application.ScreenUpdating = False
            For Each EmptyRange In FindRange
                If EmptyRange = "" Then
                    EmptyRange.Offset(, -1).Resize(, 7).Delete 2
                End If
            Next
        Application.EnableEvents = True
        Application.ScreenUpdating = True
    End If
End Sub

 

[ngothanhluan]

Cảm ơn bạn, mình làm được rồi, nhưng mình vẫn thắc mắc không biết code kia mình viết bị lỗi chỗ nào, anh chị nào có thể làm sáng tỏ vấn đề đó giúp mình không. Để cho tiện mình xin up đoạn code đó lên như sau:

Private Sub Worksheet_change(ByVal Target As Excel.Range)
On Error Resume Next
Dim vung3, vung_i, vung_i1, vung_i2 As Range
Application.EnableEvents = False
Application.ScreenUpdating = False

Set vung_i = Range("D1").Offset(Range("J1") - 2, 0)
Set vung3 = Range("D8", vung_i)
If Not Intersect(vung3, Target) Is Nothing Then
If Target = "" Then
Set vung_i1 = Target.Offset(0, -1)
Set vung_i2 = Target.Offset(0, 5)
Range(vung_i1, vung_i2).Delete Shift:=xlUp
End If
End If
Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub

 

[Hoàng Trọng Nghĩa]

Cảm ơn bạn, mình làm được rồi, nhưng mình vẫn thắc mắc không biết code kia mình viết bị lỗi chỗ nào, anh chị nào có thể làm sáng tỏ vấn đề đó giúp mình không. Để cho tiện mình xin up đoạn code đó lên như sau:

Private Sub Worksheet_change(ByVal Target As Excel.Range)
On Error Resume Next
Dim vung3, vung_i, vung_i1, vung_i2 As Range
Application.EnableEvents = False
Application.ScreenUpdating = False

Set vung_i = Range("D1").Offset(Range("J1") - 2, 0)
Set vung3 = Range("D8", vung_i)
If Not Intersect(vung3, Target) Is Nothing Then
If Target = "" Then
Set vung_i1 = Target.Offset(0, -1)
Set vung_i2 = Target.Offset(0, 5)
Range(vung_i1, vung_i2).Delete Shift:=xlUp
End If
End If
Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub

Sao tôi test lại, nó vẫn đúng mà bạn? Tôi xóa 1 ô vàng hay nhiều ô, nó vẫn chạy đúng?

 

[ngothanhluan]

Mà thôi ko sao, mình dùng code của bạn rồi, hay hơn của mình nhiều. Cảm ơn bạn nhiều.

 

[SA_DQ]

Thành thật khuyên tác giả bài viết:

VBA dù gì cũng là 1 ngôn ngữ; Trong quá trình học 1 ngôn ngữ nào bất kỳ, ta cần dịch sang tiếng mẹ đẽ những câu trong ngôn ngữ đó để thấm hiểu hơn về nó.

Còn chưa iên tâm về cách dịch của mình thì đưa lên diễn đàn; DĐ có mục dịch ngôn ngữ VBA mà!