Code thay thế chức năng filter (1 người xem)

[ruamap9]

Chào các anh chị trên diễn đàn!
Em đáng có một vấn đề vướng mắc cần các anh chị trợ giúp. Chi tiết có trong file đính kèm
Cảm ơn các anh chị!

 

[ruamap9]

Hơi khó 1 chút nhưng cũng làm được tuốt bằng Advanced Filter:

Sub RemoveDuplicate()
  Dim rFilder As Range
  On Error Resume Next
  With Range("D9:E100")
    Application.ScreenUpdating = False
    .Resize(, 1).AdvancedFilter 1, , , True
    Set rFilder = .SpecialCells(12)
    .Parent.ShowAllData
    rFilder.EntireRow.Hidden = True
    .SpecialCells(12).Delete 2
    .EntireRow.Hidden = False
  End With
  Application.ScreenUpdating = True
End Sub

Code này thực thi trên 1 Sheet. Nếu muốn nhiều sheet thì For..Next
Mời các cao thủ thêm phần for.. next vào nhé. Bây giờ các bạn mới thấy tác dụng của Parent đây

Em xin cảm ơn Thầy ndu96081631 và các anh chị. Chỉ còn vòng lặp For..Next để thực hiện cho nhiều sheet nữa mong các Pro chỉ giáo.

 

[Thong Hoang Tien 250691]

/note:
Set rng = Workbooks("Test1").Sheets(2).Range("E:F").Select
ActiveSheet.Range(rng).RemoveDuplicates Columns:=Array(1, 2), Header:=xlYes

đoạn code này của mình chạy trong file tên Book2.xlsm, nhưng sao khi chạy nó báo type mismatch nhỉ? ai giải thích giúp mình với

 

[phulien1902]

/note:
Set rng = Workbooks("Test1").Sheets(2).Range("E:F").Select
ActiveSheet.Range(rng).RemoveDuplicates Columns:=Array(1, 2), Header:=xlYes

đoạn code này của mình chạy trong file tên Book2.xlsm, nhưng sao khi chạy nó báo type mismatch nhỉ? ai giải thích giúp mình với

Bạn thử thay:

Set rng = Workbooks("Test1").Sheets(2).Range("E:F").Select

bằng:

Sheets(2).Range("E:F").Select

 

[Thong Hoang Tien 250691]

Bạn thử thay:

Set rng = Workbooks("Test1").Sheets(2).Range("E:F").Select

bằng:

Sheets(2).Range("E:F").Select

Bạn thử thay:

Set rng = Workbooks("Test1").Sheets(2).Range("E:F").Select

bằng:

Sheets(2).Range("E:F").Select

không được bạn, bạn thử xem file giúp mình có vấn đề gì với nó vậy .

 

[Thong Hoang Tien 250691]

Public Sub ABC()
Dim wb1 As Workbook, wb2 As Workbook
Dim ws1 As Worksheet, ws2 As Worksheet
Dim rng1 As Range, rng2 As Range

     ChDir "C:\Users\thoangti\Desktop\"
  Workbooks.OpenText Filename:= _
        "C:\Users\thoangti\Desktop\Test1.xlsx"
Workbooks("Test1.xlsx").Activate
Set wb1 = Workbooks("test1")
Set ws1 = Sheets(1)
Set ws2 = Sheets(2)
With wb1
With ws2
        .Range("D:H").ClearContents
End With
With ws1
        lR1 = .Range("B" & Rows.Count).End(xlUp).Row
For i = 2 To lR1
    Set code = Sheets(1).Cells(i, 5)
    Set vTO = Sheets(1).Cells(i, 2)
If Len(code) = 7 Then
        vcode = code
    Else
        vcode = "0" & code
End If
 
        copydata = Workbooks("Test1").Sheets(2).Cells(Rows.Count, "E").End(xlUp).Row
        Workbooks("Test1").Sheets(2).Cells(copydata + 1, "E") = vTO
        Workbooks("Test1").Sheets(2).Cells(copydata + 1, "F") = vcode
    
    Next i
   End With
With ws2
    lr2 = .Range("E" & Rows.Count).End(xlUp).Row
    Set rng = Workbooks("Test1").Sheets(2).Range("E:F").Select
    ActiveSheet.Range(rng).RemoveDuplicates Columns:=Array(1, 2), Header:=xlYes 'bi loi o day
    
End With
 End With
End Sub