Xin giúp đỡ code xóa các dữ liệu trùng nhau (1 người xem)

[LYSM]

Em chào cả nhà! em có file tách dữ liệu như file đính kèm, bây giờ em muốn ở sheet "Mo mau" phần cột B (từ B8) những ngày nào giống nhau thì chỉ lấy tại dòng đầu tiên, các ngày sau thì bị xóa trắng (những cell màu vàng thì xóa hết ạ). Em cảm ơn nhiều!

 

[leonguyenz]

Em chào cả nhà! em có file tách dữ liệu như file đính kèm, bây giờ em muốn ở sheet "Mo mau" phần cột B (từ B8) những ngày nào giống nhau thì chỉ lấy tại dòng đầu tiên, các ngày sau thì bị xóa trắng (những cell màu vàng thì xóa hết ạ). Em cảm ơn nhiều!

Dùng AdvancedFilter thử xem, code còn củ chuối nên copy ra chỗ khác rồi xoá dòng.
[gpecode=vb]
Sub XoaTLap()
Application.ScreenUpdating = False
Dim eR As Long
With Sheet2
eR = .[B65535].End(3).Row
.Range("B7:B" & eR).AdvancedFilter 1, , , 1
.Range("A8:J" & eR).Copy
.Range("A" & eR + 1).PasteSpecial 3
.ShowAllData
.Range("A8:J" & eR).EntireRow.Delete
.[A1].Select
End With
Application.ScreenUpdating = True
End Sub
[/gpecode]

 

[LYSM]

Dùng AdvancedFilter thử xem, code còn củ chuối nên copy ra chỗ khác rồi xoá dòng.
[gpecode=vb]
Sub XoaTLap()
Application.ScreenUpdating = False
Dim eR As Long
With Sheet2
eR = .[B65535].End(3).Row
.Range("B7:B" & eR).AdvancedFilter 1, , , 1
.Range("A8:J" & eR).Copy
.Range("A" & eR + 1).PasteSpecial 3
.ShowAllData
.Range("A8:J" & eR).EntireRow.Delete
.[A1].Select
End With
Application.ScreenUpdating = True
End Sub
[/gpecode]

Không được rồi bác ơi, em chỉ muốn xóa các cell có màu vàng chứ không muốn xóa cả dòng đâu ạ (bác xem file đính kèm em xóa tay)

 

[Let'GâuGâu]

Em chào cả nhà! em có file tách dữ liệu như file đính kèm, bây giờ em muốn ở sheet "Mo mau" phần cột B (từ B8) những ngày nào giống nhau thì chỉ lấy tại dòng đầu tiên, các ngày sau thì bị xóa trắng (những cell màu vàng thì xóa hết ạ). Em cảm ơn nhiều!

nếu cột B của bạn được sắp xếp thì thử code sau

Sub xoatrung()
Dim sarr As Variant, kq(), i As Long
sarr = Range([b8], [b2000].End(3)).Value
ReDim kq(1 To UBound(sarr), 1 To 1)
kq(1, 1) = sarr(1, 1)
For i = 2 To UBound(sarr)
    If sarr(i - 1, 1) <> sarr(i, 1) Then
        kq(i, 1) = sarr(i, 1)
    End If
Next

[b8:b2000].ClearContents
[b8].Resize(i).Value = kq


End Sub

 

[leonguyenz]

Vậy thử code này xem:
[gpecode=vb]
Sub XoaTLap()
Application.ScreenUpdating = False
Dim eR As Long, iR As Long, xFind As Range
With Sheet2
eR = .[B65535].End(3).Row
For iR = eR To 9 Step -1
Set xFind = .Range("B8:B" & iR - 1).Find(Cells(iR, "B"), , xlValues, xlWhole)
If Not xFind Is Nothing Then
.Cells(iR, "B").ClearContents
End If
Next iR
End With
Application.ScreenUpdating = True
End Sub
[/gpecode]

 

[leonguyenz]

nếu cột B của bạn được sắp xếp thì thử code sau

Sub xoatrung()
Dim sarr As Variant, kq(), i As Long
sarr = Range([b8], [b2000].End(3)).Value
ReDim kq(1 To UBound(sarr), 1 To 1)
kq(1, 1) = sarr(1, 1)
For i = 2 To UBound(sarr)
    If sarr(i - 1, 1) <> sarr(i, 1) Then
        kq(i, 1) = sarr(i, 1)
    End If
Next

[b8:b2000].ClearContents
[b8].Resize(i).Value = kq


End Sub

Nếu ngày tháng sắp xếp không theo trật tự thì sao nhỉ? Em có nghĩ đến cách này nhưng nếu sắp xếp ngày tháng lộn xộn thì không ổn.
----------------
À, hình như là cố ý sắp xếp ngày tháng để xoá ngày tháng bị trùng.

 

[Let'GâuGâu]

Nếu ngày tháng sắp xếp không theo trật tự thì sao nhỉ? Em có nghĩ đến cách này nhưng nếu sắp xếp ngày tháng lộn xộn thì không ổn.
----------------
À, hình như là cố ý sắp xếp ngày tháng để xoá ngày tháng bị trùng.

nếu ko được sắp xếp chắc fải xài dictionary

 

[dhn46]

Với dạng bài này thì đâu cần sử dụng đến VBA trong khi Excel cung cấp đầy đủ công cụ để thực hiện

Ví dụ có thể làm như sau:

1/ Sort ngày tháng
2/ Tại K8 gõ công thức: =IF(B7=B8,1,0)
3/ Auto Filter tại cột K lọc ra những giá trị bằng 1 rồi xoá đi

=> Vấn đề đã được giải quyết.

 

[LYSM]

Với dạng bài này thì đâu cần sử dụng đến VBA trong khi Excel cung cấp đầy đủ công cụ để thực hiện

Ví dụ có thể làm như sau:

1/ Sort ngày tháng
2/ Tại K8 gõ công thức: =IF(B7=B8,1,0)
3/ Auto Filter tại cột K lọc ra những giá trị bằng 1 rồi xoá đi

=> Vấn đề đã được giải quyết.

Vâng, nhưng khi sử dụng với dữ liệu nhiều sẽ mất thời gian hơn nữa file này làm ra cho một nhóm người sử dụng bác ạ. Mà không phải ai cũng có kỹ năng như vậy

 

[LYSM]

Nếu ngày tháng sắp xếp không theo trật tự thì sao nhỉ? Em có nghĩ đến cách này nhưng nếu sắp xếp ngày tháng lộn xộn thì không ổn.
----------------
À, hình như là cố ý sắp xếp ngày tháng để xoá ngày tháng bị trùng.

Ổn rồi bác ạ, đúng là em cố ý sắp xếp theo ngày tháng để loại bỏ những ngày tháng bị trùng như bác nói

 

[Quang_Hải]

Thêm 1 kiểu thuật toán tà đạo dùng Advanced Filter đây

Sub xoatrung()
Dim cell As Range, Data As Range
Set Data = Range([B8], [B65536].End(3))
Data.AdvancedFilter 2, , [Z8], True
For Each cell In Range([Z9], [Z65536].End(3))
   Data.AutoFilter 1, Format(cell, "dd-mm-yy")
   Data.SpecialCells(12).Offset(1).ClearContents
Next
Data.AutoFilter: [Z8:Z1000].Clear
End Sub

 

[huuthang_bd]

Nếu dữ liệu đã được sắp xếp thì làm vầy cho khỏe

Sub Xoa()
Dim ArrData
ArrData = Range([B8], [B65536].End(xlUp)).Value
For i = UBound(ArrData, 1) To 2 Step -1
    If ArrData(i, 1) = ArrData(i - 1, 1) Then ArrData(i, 1) = ""
Next
[B8].Resize(UBound(ArrData, 1)).Value = ArrData
End Sub

 

[TrungChinhs]

Thêm 1 cách không dùng vòng lặp: sử dụng 2 chức năng Advanced Filter và SpecialCells(12)

1. Dùng Advanced Filter lọc trực tiếp và chọn những dòng không bị ẩn.
2. Bỏ Advanced Filter (ShowAllData)
3. Ẩn những dòng đang chọn tại bước 1 (những dòng để lại không xóa)
4. Xóa dữ liệu tại những dòng không bị ẩn
5. Hiện lại các dòng đã ẩn tại bước 3

Sub XoaTrung()
    With Range([b6], [b65536].End(3))
        .AdvancedFilter 1, , , True
        .SpecialCells(12).Select
        ActiveSheet.ShowAllData
        Selection.EntireRow.Hidden = True
        .SpecialCells(12).ClearContents
        .EntireRow.Hidden = False
    End With
End Sub