Xin giúp tiếp code sau khi nhấn nút xóa, thì dòng dữ liệu vừa xóa chuyển sang Sheet kế bên

[cutun2610]

Lần trước em có post 1 bài nhờ chỉnh sửa code nút xóa, và được 01 anh trên diễn dàn hỗ trợ code lại ngắn hơn mà không còn lỗi nữa. Giờ do nhu cầu cần thống kê, các anh/chị có thể hỗ trợ em viết tiếp code này với mục đích sau khi nhấn nút xóa thì dữ liệu dòng vừa xóa đó sẽ auto chuyển sang sheet kế bên để em có thể theo dõi, tổng hợp được những thông tin nào mình đã xóa được không ạ? Em cám ơn rất nhiều!!!

Đây là code mà em được giúp đỡ cho nút xóa ạ:

Private Sub btnClear_Click()
On Error Resume Next
Dim Rng As Range, p%, g%
g = Sheet1.Range("a10000").End(xlUp).Row
Do
'DoEvents
p = Sheet1.Range("a" & g).Value
If p = txtMa.Text Then
If Rng Is Nothing Then
Set Rng = Sheet1.Range("A" & g & ":F" & g)
Else
Set Rng = Union(Rng, Sheet1.Range("A" & g & ":F" & g))
End If
End If
g = g - 1
Loop Until g = 1
If Rng Is Nothing Then
MsgBox "Khong co du lieu thoa man dieu kien"
Else
If MsgBox("Ban co chac chan muon xoa khong", vbYesNo, "Xoa du lieu") = vbNo Then
Exit Sub
Else
Rng.Delete
MsgBox "Da xoa du lieu"
End If
End If
Form1.txtMa.SetFocus
End Sub

 

[Hoàng Nhật Phương]

Lần trước em có post 1 bài nhờ chỉnh sửa code nút xóa, và được 01 anh trên diễn dàn hỗ trợ code lại ngắn hơn mà không còn lỗi nữa. Giờ do nhu cầu cần thống kê, các anh/chị có thể hỗ trợ em viết tiếp code này với mục đích sau khi nhấn nút xóa thì dữ liệu dòng vừa xóa đó sẽ auto chuyển sang sheet kế bên để em có thể theo dõi, tổng hợp được những thông tin nào mình đã xóa được không ạ? Em cám ơn rất nhiều!!!

Đây là code mà em được giúp đỡ cho nút xóa ạ:

Private Sub btnClear_Click()
On Error Resume Next
Dim Rng As Range, p%, g%
g = Sheet1.Range("a10000").End(xlUp).Row
Do
'DoEvents
p = Sheet1.Range("a" & g).Value
If p = txtMa.Text Then
If Rng Is Nothing Then
Set Rng = Sheet1.Range("A" & g & ":F" & g)
Else
Set Rng = Union(Rng, Sheet1.Range("A" & g & ":F" & g))
End If
End If
g = g - 1
Loop Until g = 1
If Rng Is Nothing Then
MsgBox "Khong co du lieu thoa man dieu kien"
Else
If MsgBox("Ban co chac chan muon xoa khong", vbYesNo, "Xoa du lieu") = vbNo Then
Exit Sub
Else
Rng.Delete
MsgBox "Da xoa du lieu"
End If
End If
Form1.txtMa.SetFocus
End Sub

Bạn thử thêm đoạn này:

        Dim dongcuoi As Long
        With ThisWorkbook.Worksheets("BackUp")' chú ý tên sheet bạn muốn copy sang nhé
            dongcuoi = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
            Rng.Copy .Cells(dongcuoi, "A")  'chú ý hiện đang vào  bắt đầu từ cột A
        End With

Vào giữa 2 dòng:

        Else
'thêm đoạn bên trên vô đây nè bạn
            Rng.Delete

 

[ptm0412]

Bạn thử thêm đoạn này:

Sao không dùng Cut mà copy rồi delete?

 

[Hoàng Nhật Phương]

Sao không dùng Cut mà copy rồi delete?

Ơ , vầng đúng rồi Chú nhỉ, xài Cut khỏi mất công xóa luôn.

 

[VetMini]

Không nên. Việc nào ra việc ấy.
Nên viết một cái hàm con, tham số là tên sheet để save và một range.
Hàm sẽ xét cái range kia, copy một ô, một dòng hay nhiều dòng (union) tuỳ theo được cho cái gì.
Sau khi gọi hàm này xong thì làm thủ tục xoá.

 

[Hoàng Nhật Phương]

Không nên. Việc nào ra việc ấy.
Nên viết một cái hàm con, tham số là tên sheet để save và một range.
Hàm sẽ xét cái range kia, copy một ô, một dòng hay nhiều dòng (union) tuỳ theo được cho cái gì.
Sau khi gọi hàm này xong thì làm thủ tục xoá.

Bác ơi như này liệu code có chạy không ạ

Private Sub btnClear_Click()
'....code cũ
Exit Sub
Else
       BackUp_tùmù ThisWorkbook.Worksheets("BackUp"), Rng
       Rng.Delete
'......code cũ
End Sub

Sub BackUp_tùmù(ByVal shBK As Worksheet, ByVal rBK As Range)
    On Error GoTo chuaxacdinh
    If rBK Is Nothing Then Exit Sub
    Dim r As Long
    r = shBK.Range("A" & Rows.Count).End(xlUp).Row
    If r > 1 Then r = r + 1
    shBK.Range("A" & r).Resize(rBK.Columns.Count, rBK.Rows.Count).Value = rBK.Value
chuaxacdinh:
End Sub

 

[SA_DQ]

@Chủ bài đăng:

Đây là macro của bạn đã được chỉnh sửa 1 chút cho đỡ nhìn:

Private Sub btnClear_Click()
On Error Resume Next   '  *    '
 Dim Rng As Range, P%, G%

1 G = Sheet3.Range("a10000").End(xlUp).Row   '1=>3   '
 Do                                     'DoEvents '
3    P = Sheet3.Range("a" & G).Value
    If P = txtMa.Text Then
5        If Rng Is Nothing Then
            Set Rng = Sheet3.Range("A" & G & ":F" & G)
7        Else
            Set Rng = Union(Rng, Sheet3.Range("A" & G & ":F" & G))
9        End If
    End If
11    G = G - 1
 Loop Until G = 1
 
13 If Rng Is Nothing Then
    MsgBox "Không Có Du Liêu Thoa Man Diêu Kiên"
15 Else
    If MsgBox("Ban Có Chác Chán Muôn Xoá Không?", vbYesNo, "Xóa Du Liêu") = vbNo Then
17        Exit Sub
    Else
19        Rng.Delete:                 MsgBox "Da Xóa Du Liêu"
    End If
21 End If
 Form1.txtMa.SetFocus
End Sub

Nhìn tổng quát, tôi hình dung là bạn có CSDL ví dụ gồm 99 dòng dữ liệu & cột đầu tiên (thuộc loại Integer) ba động từ 1 cho đến 35; Có nghĩa là trong cột này có 1 số dòng có cùng giá trị (mà bạn muốn tìm ra & xóa đi nếu nó trùng với trị mà bạn đã nhập vô TextBox có tên là txtMa)

Chương trình của bạn gồm 2 phần, đó là tìm & diệt.
Phương án 'Tìm' của bạn theo cách duyệt vòng lặp từ đầu đến cuối, dòng nào thỏa bạn ghi vô biến (kiểu Range)
Phần cuối là nếu có vùng cần xóa thì xóa đi;

Theo mình có 1 số câu lệnh chưa hay lắm, ví dụ
1) On Error Resume Next : Xài câu lệnh này không phải lúc nào cũng hay, mà thường cái dỡ bị ẩn đi & gây phiền phúc cho bạn nếu có.
2) Giai đoạn đầu (tìm kiếm) ta nên xài phương thức FIND() sẽ cải thiện tốc độ hơn 1 tẹo (so với duyệt vòng lặp từ đầu chí cuối)
Đó là chưa kể bạn nên xài vòng lặp For . . . Next (từ dưới lên trên) hay hơn là Do . . . Loop

Vài lời & những mong bạn tham khảo được ít nhiều!

 

[kimtanmap]

Không nên. Việc nào ra việc ấy.
Nên viết một cái hàm con, tham số là tên sheet để save và một range.
Hàm sẽ xét cái range kia, copy một ô, một dòng hay nhiều dòng (union) tuỳ theo được cho cái gì.
Sau khi gọi hàm này xong thì làm thủ tục xoá.

Anh có thể viết macro cho hàm con này được không ạ?

 

[cutun2610]

Bạn thử thêm đoạn này:

        Dim dongcuoi As Long
        With ThisWorkbook.Worksheets("BackUp")' chú ý tên sheet bạn muốn copy sang nhé
            dongcuoi = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
            Rng.Copy .Cells(dongcuoi, "A")  'chú ý hiện đang vào  bắt đầu từ cột A
        End With

Vào giữa 2 dòng:

        Else
'thêm đoạn bên trên vô đây nè bạn
            Rng.Delete

Dạ, tuyệt vời quá chị ơi, e chạy thử đúng như của em đang cần, em cám ơn chị rất nhiều nhiều ạ

Bài đã được tự động gộp: 26/7/21

Sao không dùng Cut mà copy rồi delete?

Dạ, tại em đang dùng một Form nhập liệu và tìm kiếm, trong form đó sau khi nhập thông tin tìm kiếm nếu em không cần nữa thì nhấn delete trên form luôn ạ

Bài đã được tự động gộp: 26/7/21

@Chủ bài đăng:

Đây là macro của bạn đã được chỉnh sửa 1 chút cho đỡ nhìn:

Private Sub btnClear_Click()
On Error Resume Next   '  *    '
 Dim Rng As Range, P%, G%

1 G = Sheet3.Range("a10000").End(xlUp).Row   '1=>3   '
 Do                                     'DoEvents '
3    P = Sheet3.Range("a" & G).Value
    If P = txtMa.Text Then
5        If Rng Is Nothing Then
            Set Rng = Sheet3.Range("A" & G & ":F" & G)
7        Else
            Set Rng = Union(Rng, Sheet3.Range("A" & G & ":F" & G))
9        End If
    End If
11    G = G - 1
 Loop Until G = 1
 
13 If Rng Is Nothing Then
    MsgBox "Không Có Du Liêu Thoa Man Diêu Kiên"
15 Else
    If MsgBox("Ban Có Chác Chán Muôn Xoá Không?", vbYesNo, "Xóa Du Liêu") = vbNo Then
17        Exit Sub
    Else
19        Rng.Delete:                 MsgBox "Da Xóa Du Liêu"
    End If
21 End If
 Form1.txtMa.SetFocus
End Sub

Nhìn tổng quát, tôi hình dung là bạn có CSDL ví dụ gồm 99 dòng dữ liệu & cột đầu tiên (thuộc loại Integer) ba động từ 1 cho đến 35; Có nghĩa là trong cột này có 1 số dòng có cùng giá trị (mà bạn muốn tìm ra & xóa đi nếu nó trùng với trị mà bạn đã nhập vô TextBox có tên là txtMa)

Chương trình của bạn gồm 2 phần, đó là tìm & diệt.
Phương án 'Tìm' của bạn theo cách duyệt vòng lặp từ đầu đến cuối, dòng nào thỏa bạn ghi vô biến (kiểu Range)
Phần cuối là nếu có vùng cần xóa thì xóa đi;

Theo mình có 1 số câu lệnh chưa hay lắm, ví dụ
1) On Error Resume Next : Xài câu lệnh này không phải lúc nào cũng hay, mà thường cái dỡ bị ẩn đi & gây phiền phúc cho bạn nếu có.
2) Giai đoạn đầu (tìm kiếm) ta nên xài phương thức FIND() sẽ cải thiện tốc độ hơn 1 tẹo (so với duyệt vòng lặp từ đầu chí cuối)
Đó là chưa kể bạn nên xài vòng lặp For . . . Next (từ dưới lên trên) hay hơn là Do . . . Loop

Vài lời & những mong bạn tham khảo được ít nhiều!

Dạ, em cám ơn bài hỗ trợ rất nhiệt tình của anh ạ, em sẽ nghiên cứu và tập code thử theo hướng dẫn của anh để hiểu hơn ạ, tại thật ra em là tay ngang, lên mạng và youtube học từ nguời này nguời kia nên kiến thức về VBA của em còn hạn chế nhiều lắm, hihi