Xem giúp code lọc dữ liệu theo list cho trước. (1 người xem)

[huhumalu]

Nhờ anh em chỉnh sửa giải thích giùm, mình có ý dùng array mà sau sau một chập nó chạy đơ luôn, không dừng, chạy không chính xác nữa.

Sub Main()
Dim i, iR As Long, j As Long
Sheets("Sheet2").Select
Dim dontDelete
dontDelete = WorksheetFunction.Transpose(Range("A1:A20"))
Sheets("Sheet1").Select
Dim Data
iR = Range("A2").End(xlDown).Rows
Data = WorksheetFunction.Transpose(Range("A2:A" & iR))
For i = LBound(Data) To UBound(Data)
    For j = LBound(dontDelete) To UBound(dontDelete)
        If Data(i) <> dontDelete(j) Then
            Range("A2").Offset(i - 1, 0).EntireRow.Delete
        End If
    Next j
Next i
End Sub

 

[langtuchungtinh360]

Nhờ anh em chỉnh sửa giải thích giùm, mình có ý dùng array mà sau sau một chập nó chạy đơ luôn, không dừng, chạy không chính xác nữa.

Sub Main()
Dim i, iR As Long, j As Long
Sheets("Sheet2").Select
Dim dontDelete
dontDelete = WorksheetFunction.Transpose(Range("A1:A20"))
Sheets("Sheet1").Select
Dim Data
iR = Range("A2").End(xlDown).Rows
Data = WorksheetFunction.Transpose(Range("A2:A" & iR))
For i = LBound(Data) To UBound(Data)
    For j = LBound(dontDelete) To UBound(dontDelete)
        If Data(i) <> dontDelete(j) Then
            Range("A2").Offset(i - 1, 0).EntireRow.Delete
        End If
    Next j
Next i
End Sub

chạy code có 1 lần mà đơ luôn rồi bạn khỏi nói lần thứ 2. bạn muốn lọc cái gì mới được chứ nhìn chả hiểu
nếu chỉ lọc ra những số ở A1:A2 ở sheet2 thì excel có sẵn mà cần gì code

 

[Quang_Hải]

Nhờ anh em chỉnh sửa giải thích giùm, mình có ý dùng array mà sau sau một chập nó chạy đơ luôn, không dừng, chạy không chính xác nữa.

Sub Main()
Dim i, iR As Long, j As Long
Sheets("Sheet2").Select
Dim dontDelete
dontDelete = WorksheetFunction.Transpose(Range("A1:A20"))
Sheets("Sheet1").Select
Dim Data
iR = Range("A2").End(xlDown).Rows
Data = WorksheetFunction.Transpose(Range("A2:A" & iR))
For i = LBound(Data) To UBound(Data)
    For j = LBound(dontDelete) To UBound(dontDelete)
        If Data(i) <> dontDelete(j) Then
            Range("A2").Offset(i - 1, 0).EntireRow.Delete
        End If
    Next j
Next i
End Sub

Sửa lại thế này

Sub Main()
Dim i As Long, k As Long, j As Long, Res()
Dim dontDelete(), Data(), Dic As Object
Set Dic = CreateObject("scripting.dictionary")
With Sheets("Sheet2")
   dontDelete = .Range("A1", .[A65536].End(3)).Value
End With
With Sheets("Sheet1")
   Data = .Range("A2", .[A65536].End(3)).Resize(, 11).Value
End With
ReDim Res(1 To UBound(Data), 1 To UBound(Data, 2))
For i = LBound(dontDelete) To UBound(dontDelete)
   Dic(dontDelete(i, 1)) = ""
Next i
For i = LBound(Data) To UBound(Data)
   If Dic.exists(Data(i, 1)) Then
      k = k + 1
      For j = LBound(Data, 2) To UBound(Data, 2)
         Res(k, j) = Data(i, j)
      Next
   End If
Next i
Sheets("sheet1").[A2].Resize(UBound(Data), UBound(Data, 2)) = Res
End Sub

 

[huhumalu]

Sửa lại thế này

Sub Main()
Dim i As Long, k As Long, j As Long, Res()
Dim dontDelete(), Data(), Dic As Object
Set Dic = CreateObject("scripting.dictionary")
With Sheets("Sheet2")
   dontDelete = .Range("A1", .[A65536].End(3)).Value
End With
With Sheets("Sheet1")
   Data = .Range("A2", .[A65536].End(3)).Resize(, 11).Value
End With
ReDim Res(1 To UBound(Data), 1 To UBound(Data, 2))
For i = LBound(dontDelete) To UBound(dontDelete)
   Dic(dontDelete(i, 1)) = ""
Next i
For i = LBound(Data) To UBound(Data)
   If Dic.exists(Data(i, 1)) Then
      k = k + 1
      For j = LBound(Data, 2) To UBound(Data, 2)
         Res(k, j) = Data(i, j)
      Next
   End If
Next i
Sheets("sheet1").[A2].Resize(UBound(Data), UBound(Data, 2)) = Res
End Sub

Ồ, cảm ơn anh quanghai1969 rất nhiều. Sửa lại chạy rất ngon.

 

[dhn46]

Dùng Dictionary như anh Hải là nhanh lắm rồi, nhưng nếu mới tìm hiểu mảng thì bạn có thể tham khảo Code sau đã sửa theo cách suy luận của bạn. Nếu bạn đã sử dụng nhiều Ubound, Lbound ... thì tốt nhất bạn nên đặt chúng vào các biến sẽ cải thiện tốc độ hơn và code gọn hơn (bạn tự thử nghiệm nhé).

Sub Main1()
    Dim i, iR As Long, jC As Long, j As Long, k As Long
    Sheets("Sheet2").Select
    Dim dontDelete, Data, Res
    dontDelete = Sheets("Sheet2").Range("A1:A" & Sheets("Sheet2").Range("A65536").End(3).Row)
    Sheets("Sheet1").Select
    iR = Sheets("Sheet1").Range("A2").End(xlDown).Rows
    Data = Sheets("Sheet1").Range("A2:K" & iR)
    ReDim Res(1 To UBound(Data, 1), UBound(Data, 2))
    For i = LBound(Data, 1) To UBound(Data, 1)
        For j = LBound(dontDelete, 1) To UBound(dontDelete, 1)
            If Data(i, 1) = dontDelete(j, 1) Then
                k = k + 1
                For jC = LBound(Data, 2) To UBound(Data, 2)
                    Res(k, jC) = Data(i, jC)
                Next
            End If
        Next j
    Next i
    Sheet1.Range("N2").Resize(k, 11) = Res
End Sub

 

[huhumalu]

Dùng Dictionary như anh Hải là nhanh lắm rồi, nhưng nếu mới tìm hiểu mảng thì bạn có thể tham khảo Code sau đã sửa theo cách suy luận của bạn. Nếu bạn đã sử dụng nhiều Ubound, Lbound ... thì tốt nhất bạn nên đặt chúng vào các biến sẽ cải thiện tốc độ hơn và code gọn hơn (bạn tự thử nghiệm nhé).

Sub Main1()
    Dim i, iR As Long, jC As Long, j As Long, k As Long
    Sheets("Sheet2").Select
    Dim dontDelete, Data, Res
    dontDelete = Sheets("Sheet2").Range("A1:A" & Sheets("Sheet2").Range("A65536").End(3).Row)
    Sheets("Sheet1").Select
    iR = Sheets("Sheet1").Range("A2").End(xlDown).Rows
    Data = Sheets("Sheet1").Range("A2:K" & iR)
    ReDim Res(1 To UBound(Data, 1), UBound(Data, 2))
    For i = LBound(Data, 1) To UBound(Data, 1)
        For j = LBound(dontDelete, 1) To UBound(dontDelete, 1)
            If Data(i, 1) = dontDelete(j, 1) Then
                k = k + 1
                For jC = LBound(Data, 2) To UBound(Data, 2)
                    Res(k, jC) = Data(i, jC)
                Next
            End If
        Next j
    Next i
    Sheet1.Range("N2").Resize(k, 11) = Res
End Sub

Rất cảm ơn dhn46, mình sẽ cố học hỏi thêm, có chổ nào không rõ mình sẽ phiền bạn vậy. Thanks !