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

[mtnguyen9268]

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 đỡ

 

[hoangexcell]

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.

 

[snow25]

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ử.

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

 

[mtnguyen9268]

Bạn thử.

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 )))