Nhờ mọi người giúp em về xóa dữ liệu trùng lặp( Remove Duplicates) nhiều cột với ạ

[zPeterPan]

Em chào các anh chị em GPE . Mọi người cho em hỏi về cách xóa trùng lặp nhiều cột với ạ ( khoảng 1000 cột). . .
chứ viết theo Record Marcro ( sửa thủ công hơn 1000 cột thì nhọc lắm ạ )
đây là em ví dụ 5 cột ạ. . .

nhờ mọi người giúp em với ạ. . .

 

[CHAOQUAY]

Em chào các anh chị em GPE . Mọi người cho em hỏi về cách xóa trùng lặp nhiều cột với ạ ( khoảng 1000 cột). . .
chứ viết theo Record Marcro ( sửa thủ công hơn 1000 cột thì nhọc lắm ạ )
đây là em ví dụ 5 cột ạ. . .
View attachment 254917
nhờ mọi người giúp em với ạ. . .

...

Sub abc()
Dim nguon
Dim kq
Dim i, j, k, x, z
nguon = Sheet1.Range("G3:K12")
x = UBound(nguon)
z = UBound(nguon, 2)
ReDim kq(1 To x, 1 To z)
With CreateObject("Scripting.Dictionary")
    For j = 1 To z
        k = 0
        For i = 1 To x
            If .exists(nguon(i, j)) = 0 Then
                .Item(nguon(i, j)) = ""
                k = k + 1
                kq(k, j) = nguon(i, j)
            End If
        Next i
        .RemoveAll
    Next j
End With
Sheet1.Range("M3").Resize(x, z).ClearContents
Sheet1.Range("M3").Resize(x, z) = kq
End Sub

 

[HieuCD]

Em chào các anh chị em GPE . Mọi người cho em hỏi về cách xóa trùng lặp nhiều cột với ạ ( khoảng 1000 cột). . .
chứ viết theo Record Marcro ( sửa thủ công hơn 1000 cột thì nhọc lắm ạ )
đây là em ví dụ 5 cột ạ. . .
View attachment 254917
nhờ mọi người giúp em với ạ. . .

Chạy code

Sub RemoveDuplicates()
  Dim eCol&, eRow&, j&
  With Sheet1
    eCol = .Range("G3").End(xlToRight).Column
    For j = 7 To eCol
      eRow = .Cells(Rows.Count, j).End(xlUp).Row
      .Cells(3, j).Resize(eRow - 2).RemoveDuplicates Columns:=1, Header:=xlNo
    Next j
  End With
End Sub

 

[zPeterPan]

...

Sub abc()
Dim nguon
Dim kq
Dim i, j, k, x, z
nguon = Sheet1.Range("G3:K12")
x = UBound(nguon)
z = UBound(nguon, 2)
ReDim kq(1 To x, 1 To z)
With CreateObject("Scripting.Dictionary")
    For j = 1 To z
        k = 0
        For i = 1 To x
            If .exists(nguon(i, j)) = 0 Then
                .Item(nguon(i, j)) = ""
                k = k + 1
                kq(k, j) = nguon(i, j)
            End If
        Next i
        .RemoveAll
    Next j
End With
Sheet1.Range("M3").Resize(x, z).ClearContents
Sheet1.Range("M3").Resize(x, z) = kq
End Sub

Em cảm ơn bác ChaoQuay nhiều ạ

Bài đã được tự động gộp: 5/3/21

Chạy code

Sub RemoveDuplicates()
  Dim eCol&, eRow&, j&
  With Sheet1
    eCol = .Range("G3").End(xlToRight).Column
    For j = 7 To eCol
      eRow = .Cells(Rows.Count, j).End(xlUp).Row
      .Cells(3, j).Resize(eRow - 2).RemoveDuplicates Columns:=1, Header:=xlNo
    Next j
  End With
End Sub

Em cảm ơn bác HieuCD đã giúp em rất nhiều ạ