Xóa dữ liệu bị trùng lặp theo hàng ngang

[TgiaiDungLe]

Chào mọi người, mình là thành viên mới. Hôm nay, mình có 1 chút việc với file excel của mình. Các dữ liệu của mình là ngày tháng bị dồn theo 1 hàng ngang, có nhiều cột. Bây giờ mình muốn xóa dữ liệu trùng theo hàng ngang thì làm thế nào ạ.
Ví dụ :
3/1/2019 3/1/2019 3/1/2019 3/1/2019 => xóa hết các cells bị trùng dữ liệu và gộp lại thành duy nhất 1 cells 3/1/2019
Rất mong nhận được sự giúp đỡ ạ

 

[Lê Hồng Minh83]

Chào mọi người, mình là thành viên mới. Hôm nay, mình có 1 chút việc với file excel của mình. Các dữ liệu của mình là ngày tháng bị dồn theo 1 hàng ngang, có nhiều cột. Bây giờ mình muốn xóa dữ liệu trùng theo hàng ngang thì làm thế nào ạ.
Ví dụ :
3/1/2019 3/1/2019 3/1/2019 3/1/2019 => xóa hết các cells bị trùng dữ liệu và gộp lại thành duy nhất 1 cells 3/1/2019
Rất mong nhận được sự giúp đỡ ạ

Bạn dùng tạm cách copy dữ liệu chuyển từ dòng thành cột (transpose) rồi dùng công cụ remove duplicates loại trùng rồi copy paste transpose để trả về dòng ban đầu
còn muốn nhanh hơn thì VBA nhé

 

[snow25]

Chào mọi người, mình là thành viên mới. Hôm nay, mình có 1 chút việc với file excel của mình. Các dữ liệu của mình là ngày tháng bị dồn theo 1 hàng ngang, có nhiều cột. Bây giờ mình muốn xóa dữ liệu trùng theo hàng ngang thì làm thế nào ạ.
Ví dụ :
3/1/2019 3/1/2019 3/1/2019 3/1/2019 => xóa hết các cells bị trùng dữ liệu và gộp lại thành duy nhất 1 cells 3/1/2019
Rất mong nhận được sự giúp đỡ ạ

File đâu ta.Mà dùng VBA không.

 

[TgiaiDungLe]

Bạn dùng tạm cách copy dữ liệu chuyển từ dòng thành cột (transpose) rồi dùng công cụ remove duplicates loại trùng rồi copy paste transpose để trả về dòng ban đầu
còn muốn nhanh hơn thì VBA nhé

Cách này xử lý dữ liệu lớn rất chậm bác ơi, ý mình là sử dụng VBA để đạt được hiệu quả nhanh nhất ấy
Mình gửi file đính kèm lên luôn nha

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

Bạn dùng tạm cách copy dữ liệu chuyển từ dòng thành cột (transpose) rồi dùng công cụ remove duplicates loại trùng rồi copy paste transpose để trả về dòng ban đầu
còn muốn nhanh hơn thì VBA nhé

Nhờ bác hỗ trợ giúp mình phần VBA, mình đang mò mẫm hoài chưa đc

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

File đâu ta.Mà dùng VBA không.

mình đã gửi file rồi đó bạn, mà không ai giúp mình hết à

 

[snow25]

Cách này xử lý dữ liệu lớn rất chậm bác ơi, ý mình là sử dụng VBA để đạt được hiệu quả nhanh nhất ấy
Mình gửi file đính kèm lên luôn nha

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

Nhờ bác hỗ trợ giúp mình phần VBA, mình đang mò mẫm hoài chưa đc

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

mình đã gửi file rồi đó bạn, mà không ai giúp mình hết à

Bạn xem nhé kết quả trả về sheets2.

Sub gopdulieu()
   Dim arr, arr1, dic As Object, i As Long, j As Long, a As Long, dk As Long, lr As Long
   Set dic = CreateObject("scripting.dictionary")
   With Sheets("sheet1")
        lr = .Range("A" & Rows.Count).End(xlUp).Row
        arr = .Range("A2:HO" & lr).Value
        ReDim arr1(1 To UBound(arr, 1), 1 To UBound(arr, 2))
        For i = 1 To UBound(arr, 1)
            For j = 1 To UBound(arr, 2)
            If TypeName(arr(i, j)) <> "Error" Then
            If arr(i, j) <> Empty Then
                dk = CLng(arr(i, j))
                If Not dic.exists(dk) Then
                   dic.Add dk, ""
                   a = a + 1
                   arr1(i, a) = arr(i, j)
                 End If
            End If
            End If
            Next j
          dic.RemoveAll
          a = 0
       Next i
    End With
    With Sheets("sheet2")
       .Cells.ClearContents
        .Range("A1").Resize(i - 1, j).Value = arr1
    End With
End Sub

 

[TgiaiDungLe]

Bạn xem nhé kết quả trả về sheets2.

Sub gopdulieu()
   Dim arr, arr1, dic As Object, i As Long, j As Long, a As Long, dk As Long, lr As Long
   Set dic = CreateObject("scripting.dictionary")
   With Sheets("sheet1")
        lr = .Range("A" & Rows.Count).End(xlUp).Row
        arr = .Range("A2:HO" & lr).Value
        ReDim arr1(1 To UBound(arr, 1), 1 To UBound(arr, 2))
        For i = 1 To UBound(arr, 1)
            For j = 1 To UBound(arr, 2)
            If TypeName(arr(i, j)) <> "Error" Then
            If arr(i, j) <> Empty Then
                dk = CLng(arr(i, j))
                If Not dic.exists(dk) Then
                   dic.Add dk, ""
                   a = a + 1
                   arr1(i, a) = arr(i, j)
                 End If
            End If
            End If
            Next j
          dic.RemoveAll
          a = 0
       Next i
    End With
    With Sheets("sheet2")
       .Cells.ClearContents
        .Range("A1").Resize(i - 1, j).Value = arr1
    End With
End Sub

Cảm ơn bác rất nhiều ạ

 

[VetMini]

...
        For i = 1 To UBound(arr, 1)
            For j = 1 To UBound(arr, 2)
            If TypeName(arr(i, j)) <> "Error" Then
            If arr(i, j) <> Empty Then
                dk = CLng(arr(i, j))
                If Not dic.exists(dk) Then
                   dic.Add dk, ""
                   a = a + 1
                   arr1(i, a) = arr(i, j)
                 End If
            End If
            End If
            Next j
          dic.RemoveAll
          a = 0
       Next i
...

Dữ liệu Long thì dùng Array hiệu quả hơn

Dim ngay(0 To 100000) As Boolean ' 100000 đủ để làm số ngày 1900-2200
        For i = 1 To UBound(arr, 1)
            For j = 1 To UBound(arr, 2)
            If TypeName(arr(i, j)) <> "Error" Then
            If arr(i, j) <> Empty Then
                dk = CLng(arr(i, j))
                If Not ngay(dk) Then
                   ngay(dk) = True
                   a = a + 1
                   arr1(i, a) = arr(i, j)
                 End If
            End If
            End If
            Next j
          Erase ngay
          a = 0
       Next i

 

[snow25]

Dữ liệu Long thì dùng Array hiệu quả hơn

Dim ngay(0 To 100000) As Boolean ' 100000 đủ để làm số ngày 1900-2200
        For i = 1 To UBound(arr, 1)
            For j = 1 To UBound(arr, 2)
            If TypeName(arr(i, j)) <> "Error" Then
            If arr(i, j) <> Empty Then
                dk = CLng(arr(i, j))
                If Not ngay(dk) Then
                   ngay(dk) = True
                   a = a + 1
                   arr1(i, a) = arr(i, j)
                 End If
            End If
            End If
            Next j
          Erase ngay
          a = 0
       Next i

Vâng cháu cảm ơn bác ạ.Cái này nhanh hơn ạ.

 

[TgiaiDungLe]

cảm ơn bác snow25 và VetMini đã nhiệt tình hỗ trợ ạ