Xin các thầy giúp đỡ phần code xóa vùng dữ liệu theo điều kiện. (1 người xem)

Liên hệ QC

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

haikimcuong

Thành viên hoạt động
Tham gia
6/7/10
Bài viết
169
Được thích
36
Em có 1 file công nợ hiện tại đã có code lọc các tên theo như file em đính kèm cụ thể như sau:
Trong sheet 1 có ô K3 khi em gõ tên vào ô đó nó sẽ tự động lọc ra các tên khách hang nợ có tên trùng(từ A4:I65530) với tên gõ và liệt kê xuống dưới(bắt đầu trong vùng K4:R65530).
Sau khi xác nhận thanh toán click vào button xóa nợ nó sẽ tự động xóa tất cả các dòng dữ liệu xuất hiện cả 2 vùng dữ liệu nêu trên.
Cảm ơn các thầy!
 

File đính kèm

Em có 1 file công nợ hiện tại đã có code lọc các tên theo như file em đính kèm cụ thể như sau:
Trong sheet 1 có ô K3 khi em gõ tên vào ô đó nó sẽ tự động lọc ra các tên khách hang nợ có tên trùng(từ A4:I65530) với tên gõ và liệt kê xuống dưới(bắt đầu trong vùng K4:R65530).
Sau khi xác nhận thanh toán click vào button xóa nợ nó sẽ tự động xóa tất cả các dòng dữ liệu xuất hiện cả 2 vùng dữ liệu nêu trên.
Cảm ơn các thầy!
Thử code củ chuối này xem sao: code lỗi vòng lặp, đang sửa lại
 
Lần chỉnh sửa cuối:
Upvote 0
Thử code củ chuối này xem sao: code lỗi vòng lặp, đang sửa lại
PHP:
Sub vd()
Application.ScreenUpdating = False
On Error ResumeNext
For j = 4 To 100 Step 1
For i = 4 To 100 Step 1
    If Sheets("Sheet1").Range("C" & i).Value = Range("M" & j).Value Then Sheets("Sheet1").Range("B" & i, "I" & i).Delete   
 If Range("M" & j).Value = "" Then Exit Sub
Next
Next
Application.ScreenUpdating = True
End Sub
 
Upvote 0
PHP:
Sub vd()
Application.ScreenUpdating = False
On Error ResumeNext
For j = 4 To 100 Step 1
For i = 4 To 100 Step 1
    If Sheets("Sheet1").Range("C" & i).Value = Range("M" & j).Value Then Sheets("Sheet1").Range("B" & i, "I" & i).Delete   
 If Range("M" & j).Value = "" Then Exit Sub
Next
Next
Application.ScreenUpdating = True
End Sub
em đưa vào thử ví dụ đó thì bị lỗi dòng On Error ResumeNext thầy ơi thầy xem và up trực tiếp vào form giúp em với, em gà lắm ạ.
 
Upvote 0
Upvote 0
Thực long tất cả các vấn đề em đưa ra đều cố gang làm tài lieu để sau này em học tập(không đúng ra là bây giờ) các thầy ạ nên nếu có hỏi những câu ngớ ngẩn thì kính mong các thầy bỏ quá cho em. Cảm ơn các thầy.
 
Upvote 0

File đính kèm

Upvote 0
File tiếp đây bạn, bạn xem đạt yêu cầu chưa nha
Điều kiện hỏi trước khi xóa thì chuẩn rồi thầy ạ nhưng có điều nó lại không xóa bên kia nhưng cái lần trước thầy làm mà nó lại chỉ xóa bên tìm tức là từ L4:R endR ạ, thầy giúp em xem lại 1 chút ạ.
 
Lần chỉnh sửa cuối:
Upvote 0
If Sheets("Sheet1").Range("C" & i).Value = Range("M" & j).Value Then Sheets("Sheet1").Range("B" & i, "I" & i).Delete
If Range("M" & j).Value = "" Then Exit Sub
EndR = Sheet1.Range("G65000").End(xlUp).Row
Sheet1.Range("L4:R" & EndR).ClearContents Tình hình 2 điều kiện em gạch chân không chạy nó chỉ chạy 1 trong 2 điều kiện thôi anh ạ.
 
Upvote 0
If Sheets("Sheet1").Range("C" & i).Value = Range("M" & j).Value Then Sheets("Sheet1").Range("B" & i, "I" & i).Delete
If Range("M" & j).Value = "" Then Exit Sub
EndR = Sheet1.Range("G65000").End(xlUp).Row
Sheet1.Range("L4:R" & EndR).ClearContents Tình hình 2 điều kiện em gạch chân không chạy nó chỉ chạy 1 trong 2 điều kiện thôi anh ạ.
Bạn thay code thành thế này là OK:
PHP:
Sub vd()
Application.ScreenUpdating = False
On Error Resume Next
prompt = "BAN CO CHAC CHAN XOA KHONG"
Buttons = vbYesNo + vbQuestion + vbDefaultButton1
truonghop = MsgBox(prompt, Buttons, Title)
If truonghop = vbYes Then
For j = 4 To 100 Step 1
For i = 4 To 100 Step 1
    If Sheets("Sheet1").Range("C" & i).Value = Range("M" & j).Value Then Sheets("Sheet1").Range("B" & i, "I" & i).Delete   
 If Range("M" & j).Value = "" Then Exit For
Next
Next
End If
EndR = Sheet1.Range("G65000").End(xlUp).RowSheet1.Range("L4:R" & EndR).ClearContents
Application.ScreenUpdating = True
End Sub
 
Upvote 0
Bạn thay code thành thế này là OK:
PHP:
Sub vd()
Application.ScreenUpdating = False
On Error Resume Next
prompt = "BAN CO CHAC CHAN XOA KHONG"
Buttons = vbYesNo + vbQuestion + vbDefaultButton1
truonghop = MsgBox(prompt, Buttons, Title)
If truonghop = vbYes Then
For j = 4 To 100 Step 1
For i = 4 To 100 Step 1
    If Sheets("Sheet1").Range("C" & i).Value = Range("M" & j).Value Then Sheets("Sheet1").Range("B" & i, "I" & i).Delete   
 If Range("M" & j).Value = "" Then Exit For
Next
Next
End If
EndR = Sheet1.Range("G65000").End(xlUp).RowSheet1.Range("L4:R" & EndR).ClearContents
Application.ScreenUpdating = True
End Sub
Thây ơi em đã thay vào rồi tuy nhiên nó vẫn hiện bên khoảng L4:R ạ em gửi file thầy test
 

File đính kèm

Upvote 0
Thây ơi em đã thay vào rồi tuy nhiên nó vẫn hiện bên khoảng L4:R ạ em gửi file thầy test
Tôi đã test rồi lỗi ở chổ này nè:
EndR = Sheet1.Range("G65000").End(xlUp).RowSheet1.Range("L4:R" & EndR).ClearContents
thành hai dòng này:
EndR = Sheet1.Range("G65000").End(xlUp).Row
Sheet1
.Range("L4:R" & EndR).ClearContents
Thêm file đính kèm
 

File đính kèm

Upvote 0

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

Back
Top Bottom