Nhờ mọi người viết giúp code VBA để xóa dữ liệu

Liên hệ QC

mtnguyen9268

Thành viên mới
Tham gia
18/8/18
Bài viết
11
Được thích
0
Em có một file excell gồm 2 Sheet DanhSach và HangNgay, em muốn xóa các đơn hàng trong Sheet HangNgay đã xuất hiện trong sheet Data. Dữ liệu trong 2 sheet này rất lớn và không cố định nên mọi người cần tìm dòng cuối của Dữ liệu. Em đã thử sử dụng Code này nhưng dữ liệu lớn sẽ chậm và bị đơ File:

Sub XoaDulieu()
Dim ShData As Worksheet
Dim ShList As Worksheet
Dim ix As Long
Dim il As Long
Set ShData = ThisWorkbook.Sheets("HangNgay")
Set ShList = ThisWorkbook.Sheets("DanhSach")
For ix = ShData.Range("B" & ShData.Rows.Count).End(xlUp).Row To 2 Step -1
For il = 2 To ShList.Range("B" & ShList.Rows.Count).End(xlUp).Row
If ShData.Cells(ix, 1).Value = ShList.Cells(il, 1).Value Then ShData.Cells(ix, 1).EntireRow.Delete
Next il
Next ix
End Sub.

Cám ơn mọi người giúp đỡ
 

File đính kèm

  • Xóa dữ liệu.xlsx
    3.5 MB · Đọc: 7
Em có một file excell gồm 2 Sheet DanhSach và HangNgay, em muốn xóa các đơn hàng trong Sheet HangNgay đã xuất hiện trong sheet Data. Dữ liệu trong 2 sheet này rất lớn và không cố định nên mọi người cần tìm dòng cuối của Dữ liệu. Em đã thử sử dụng Code này nhưng dữ liệu lớn sẽ chậm và bị đơ File:

Sub XoaDulieu()
Dim ShData As Worksheet
Dim ShList As Worksheet
Dim ix As Long
Dim il As Long
Set ShData = ThisWorkbook.Sheets("HangNgay")
Set ShList = ThisWorkbook.Sheets("DanhSach")
For ix = ShData.Range("B" & ShData.Rows.Count).End(xlUp).Row To 2 Step -1
For il = 2 To ShList.Range("B" & ShList.Rows.Count).End(xlUp).Row
If ShData.Cells(ix, 1).Value = ShList.Cells(il, 1).Value Then ShData.Cells(ix, 1).EntireRow.Delete
Next il
Next ix
End Sub.

Cám ơn mọi người giúp đỡ
ý bạn là dò 1 item bên ngày so với 10K item bên kia? Như vậy sẽ có 10k x 10k lần? Thì sẽ chậm là đương nhiên rồi.
Nhiều chiện vậy thôi chứ cách khác biết có nhưng chưa biết làm :)

Công thức vlookup dò xong, xóa còn nhanh hơn vòng lặp của bạn ấy.
 
Em có một file excell gồm 2 Sheet DanhSach và HangNgay, em muốn xóa các đơn hàng trong Sheet HangNgay đã xuất hiện trong sheet Data. Dữ liệu trong 2 sheet này rất lớn và không cố định nên mọi người cần tìm dòng cuối của Dữ liệu. Em đã thử sử dụng Code này nhưng dữ liệu lớn sẽ chậm và bị đơ File:

Sub XoaDulieu()
Dim ShData As Worksheet
Dim ShList As Worksheet
Dim ix As Long
Dim il As Long
Set ShData = ThisWorkbook.Sheets("HangNgay")
Set ShList = ThisWorkbook.Sheets("DanhSach")
For ix = ShData.Range("B" & ShData.Rows.Count).End(xlUp).Row To 2 Step -1
For il = 2 To ShList.Range("B" & ShList.Rows.Count).End(xlUp).Row
If ShData.Cells(ix, 1).Value = ShList.Cells(il, 1).Value Then ShData.Cells(ix, 1).EntireRow.Delete
Next il
Next ix
End Sub.

Cám ơn mọi người giúp đỡ
Bạn thử.
Mã:
Sub xoadulieu()
    Dim arr, kq, lr As Long, i As Long, dk As String, dic As Object, a As Long, j As Long
    Set dic = CreateObject("scripting.dictionary")
    With Sheets("danhsach")
         lr = .Range("B" & Rows.Count).End(xlUp).Row
         If lr < 2 Then Exit Sub
         arr = .Range("A2:B" & lr).Value
         For i = 1 To UBound(arr)
             dk = arr(i, 2)
             dic.Item(dk) = i
         Next i
    End With
    With Sheets("hangngay")
         lr = .Range("B" & Rows.Count).End(xlUp).Row
         If lr < 2 Then Exit Sub
         arr = .Range("A2:Cu" & lr).Value
         ReDim kq(1 To UBound(arr), 1 To UBound(arr, 2))
         For i = 1 To UBound(arr)
             dk = arr(i, 2)
             If Not dic.exists(dk) Then
                a = a + 1
                For j = 1 To UBound(arr, 2)
                    kq(a, j) = arr(i, j)
                Next j
             End If
         Next i
         .Range("A2:Cu" & lr).ClearContents
        If a Then .Range("A2:Cu2").Resize(a).Value = kq
    End With
End Sub
 
Bạn thử.
Mã:
Sub xoadulieu()
    Dim arr, kq, lr As Long, i As Long, dk As String, dic As Object, a As Long, j As Long
    Set dic = CreateObject("scripting.dictionary")
    With Sheets("danhsach")
         lr = .Range("B" & Rows.Count).End(xlUp).Row
         If lr < 2 Then Exit Sub
         arr = .Range("A2:B" & lr).Value
         For i = 1 To UBound(arr)
             dk = arr(i, 2)
             dic.Item(dk) = i
         Next i
    End With
    With Sheets("hangngay")
         lr = .Range("B" & Rows.Count).End(xlUp).Row
         If lr < 2 Then Exit Sub
         arr = .Range("A2:Cu" & lr).Value
         ReDim kq(1 To UBound(arr), 1 To UBound(arr, 2))
         For i = 1 To UBound(arr)
             dk = arr(i, 2)
             If Not dic.exists(dk) Then
                a = a + 1
                For j = 1 To UBound(arr, 2)
                    kq(a, j) = arr(i, j)
                Next j
             End If
         Next i
         .Range("A2:Cu" & lr).ClearContents
        If a Then .Range("A2:Cu2").Resize(a).Value = kq
    End With
End Sub

Đã được, cám ơn bạn nhiều :))))
 
Web KT
Back
Top Bottom