Lọc và xóa dữ liệu theo hàng ngang

[Dana123]

Nhờ Anh Chị Em giúp xóa trùng theo hàng ngang thì làm như thế nào ạ

 

[Hamedanger]

Hy vọng là mình hiểu đúng ý của bạn, xem file nhé

Sub LocNgang()
Dim Data(), KQ(), I&, J&, K&, Ub1Data&, Ub2KQ&, Dic As Object, IdStr As String
Data = Sheet1.Range("A1:F2").Value
Ub1Data = UBound(Data, 1)
ReDim KQ(1 To Ub1Data, 1 To 1)
Set Dic = CreateObject("Scripting.Dictionary")
For I = LBound(Data, 1) To UBound(Data, 1)
For J = LBound(Data, 2) To UBound(Data, 2)
IdStr = CStr(Data(I, J))
Ub2KQ = UBound(KQ, 2)
If Not Dic.exists(IdStr) Then
K = K + 1
If K > Ub2KQ Then ReDim Preserve KQ(1 To Ub1Data, 1 To K)
Dic.Add IdStr, K
KQ(I, J) = IdStr
End If
Next
Dic.RemoveAll
Next
Sheet1.Range("A5").Resize(UBound(KQ, 1), UBound(KQ, 2)) = KQ
End Sub

 

[Dana123]

Hy vọng là mình hiểu đúng ý của bạn, xem file nhé

DẠ. cái trên đúng rồi ạ . Nhưng nếu mình có 1 nghìn dòng trong bài trên thì làm thế nào ạ.

 

[Hamedanger]

DẠ. cái trên đúng rồi ạ . Nhưng nếu mình có 1 nghìn dòng trong bài trên thì làm thế nào ạ.

Data = Sheet1.Range("A1:F2").Value bạn thay thế cái dòng này nhé

 

[BuiQuangThuan]

Data = Sheet1.Range("A1:F2").Value bạn thay thế cái dòng này nhé

Thử 1 cách khác coi

Sub abc()
    Dim Dic As Object, Arr(), Res(), i&, iRow&, j&, Key
    Set Dic = CreateObject("Scripting.Dictionary")
    With Sheet1
        Arr = .Range("A1").CurrentRegion.Value
        ReDim Res(1 To UBound(Arr, 1), 1 To UBound(Arr, 2))
        For i = 1 To UBound(Arr, 1)
            For j = 2 To UBound(Arr, 2)
                Key = Arr(i, 1) & "#" & Arr(i, j)
                If Dic.exists(Key) = False Then
                Dic.Add (Key), ""
                Res(i, 1) = Arr(i, 1)
                Res(i, j) = Arr(i, j)
                End If
            Next
        Next
        .Range("A9").Resize(UBound(Arr, 1), UBound(Arr, 2)).Value = Res
    End With
    
End Sub

 

[Dana123]

Thử 1 cách khác coi

Sub abc()
    Dim Dic As Object, Arr(), Res(), i&, iRow&, j&, Key
    Set Dic = CreateObject("Scripting.Dictionary")
    With Sheet1
        Arr = .Range("A1").CurrentRegion.Value
        ReDim Res(1 To UBound(Arr, 1), 1 To UBound(Arr, 2))
        For i = 1 To UBound(Arr, 1)
            For j = 2 To UBound(Arr, 2)
                Key = Arr(i, 1) & "#" & Arr(i, j)
                If Dic.exists(Key) = False Then
                Dic.Add (Key), ""
                Res(i, 1) = Arr(i, 1)
                Res(i, j) = Arr(i, j)
                End If
            Next
        Next
        .Range("A9").Resize(UBound(Arr, 1), UBound(Arr, 2)).Value = Res
    End With
  
End Sub

Dạ được rồi ạ. Mà mình muốn dữ liệu nó nối đuôi nhau, ví dụ từ cột a sang cột b, chứ không phải từ cột a đến cột b ko có dữ liệu thì bỏ trống, đến cột c thì lại có dữ liệu, Loại bỏ các ô không có dữ liệu thì làm sao ạ.

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

Dạ được rồi ạ. Cảm ơn bạn nhiều ạ

Dạ được rồi ạ. Mà mình muốn dữ liệu nó nối đuôi nhau, ví dụ từ cột a sang cột b, chứ không phải từ cột a đến cột b ko có dữ liệu thì bỏ trống, đến cột c thì lại có dữ liệu, Loại bỏ các ô không có dữ liệu thì làm sao ạ.