Xử lí lấy dữ liệu trùng lặp 1 lần Excel 2010 (2 người xem)

  • Thread starter Thread starter tranmy94
  • Ngày gửi Ngày gửi
Liên hệ QC

Người dùng đang xem chủ đề này

tranmy94

Thành viên mới
Tham gia
6/2/17
Bài viết
39
Được thích
3
Dear các anh chị!
Nhờ các anh chị xử lí giúp em.
Em có dữ liệu trong nhiều ô hàng ngang, các dữ liệu có thể bị trùng lặp.
Em muốn lấy các giá trị chỉ 1 lần
1617935769573.png
Excel của em là 2010 ạ!
 

File đính kèm

Chỉnh sửa lần cuối bởi điều hành viên:
Dear các anh chị!
Nhờ các anh chị xử lí giúp em.
Em có dữ liệu trong nhiều ô hàng ngang, các dữ liệu có thể bị trùng lặp.
Em muốn lấy các giá trị chỉ 1 lần
View attachment 256825
Excel của e là 2010 ạ!
Bài này công thức chưa thử nhưng chắc khó. VBA có lẽ dễ thở hơn. Nếu bạn chấp nhận VBA thì mình làm thử
 
Dạ ! Nhờ mn cứ thử ạ. Em sẽ thử làm để áp dụng xem có được không ạ!
 
Dear các anh chị!
Nhờ các anh chị xử lí giúp em.
Em có dữ liệu trong nhiều ô hàng ngang, các dữ liệu có thể bị trùng lặp.
Em muốn lấy các giá trị chỉ 1 lần
View attachment 256825
Excel của e là 2010 ạ!

Bạn thử công thức (*) sau nhé:

=TEXTJOIN(",",TRUE,(SORT(UNIQUE(MID(SUBSTITUTE(CONCAT(A3:E3),",",""),ROW(INDIRECT("1:"&LEN(SUBSTITUTE(CONCAT(A3:E3),",","")))),1)))))

(*) Công thức này chắc chỉ dùng cho Excel 365.
 
Có cách nào để add thêm hàm Sort không ạ,
Excel của em hiện mới add hàm Textjoin, unique rồi. Còn hàm Sort chưa biết cách add ạ
Bài đã được tự động gộp:

Về cơ bản em cũng không nhất thiết phải sắp xếp theo thứ tự ABC, chỉ cần lấy được dữ liệu là được.
Nhờ các anh chỉ giáo thêm
 
Có cách nào để add thêm hàm Sort không ạ,
Excel của em hiện mới add hàm Textjoin, unique rồi. Còn hàm Sort chưa biết cách add ạ
Bài đã được tự động gộp:

Về cơ bản em cũng không nhất thiết phải sắp xếp theo thứ tự ABC, chỉ cần lấy được dữ liệu là được.
Nhờ các anh chỉ giáo thêm
Bạn thử công thức này xem:

=TEXTJOIN(",",TRUE,(UNIQUE(MID(SUBSTITUTE(TEXTJOIN(",",TRUE,A2:E2),",",""),ROW(INDIRECT("1:"&LEN(SUBSTITUTE(TEXTJOIN(",",TRUE,A2:E2),",","")))),1))))
 
1617942047741.png
Chỉ ra cái đầu tiên thôi anh ạ!
 
Có cách nào để add thêm hàm Sort không ạ,
Excel của em hiện mới add hàm Textjoin, unique rồi. Còn hàm Sort chưa biết cách add ạ
Bài đã được tự động gộp:

Về cơ bản em cũng không nhất thiết phải sắp xếp theo thứ tự ABC, chỉ cần lấy được dữ liệu là được.
Nhờ các anh chỉ giáo thêm
Cứ thế này đi, có lỗi gì tính tiếp:
Mã:
Option Explicit
Dim Dic As Object
Function ListUnique(Rng As Range, Optional Delimiter As String = ",")
Dim I As Long, J As Long, K As Long, U As Long, Txt As String
Dim iItem As Variant, sArr(), Tmp As Variant, Arr()
If Dic Is Nothing Then Set Dic = CreateObject("Scripting.Dictionary")
sArr = Rng.Value
For Each iItem In sArr
    I = I + 1
    ReDim Preserve Arr(1 To I)
    Arr(I) = iItem
Next
U = UBound(Arr)
For I = 1 To U
    Tmp = Split(Arr(I), Delimiter)
    For J = 0 To UBound(Tmp)
        K = K + 1
        If Not Dic.exists(Tmp(J)) Then
            Dic.Add Tmp(J), ""
        End If
    Next
Next
Arr = ArrayListSort(Dic.keys, True)
Txt = Join(Arr, Delimiter)
ListUnique = Txt
Dic.RemoveAll
End Function
Function ArrayListSort(sn As Variant, Optional bAscending As Boolean = True)
    With CreateObject("System.Collections.ArrayList")
        Dim cl As Variant
        For Each cl In sn
            .Add cl
        Next
        .Sort
        If bAscending = False Then .Reverse
        ArrayListSort = .Toarray()
    End With
End Function
 

File đính kèm

Cứ thế này đi, có lỗi gì tính tiếp:
Mã:
Option Explicit
Dim Dic As Object
Function ListUnique(Rng As Range, Optional Delimiter As String = ",")
Dim I As Long, J As Long, K As Long, U As Long, Txt As String
Dim iItem As Variant, sArr(), Tmp As Variant, Arr()
If Dic Is Nothing Then Set Dic = CreateObject("Scripting.Dictionary")
sArr = Rng.Value
For Each iItem In sArr
    I = I + 1
    ReDim Preserve Arr(1 To I)
    Arr(I) = iItem
Next
U = UBound(Arr)
For I = 1 To U
    Tmp = Split(Arr(I), Delimiter)
    For J = 0 To UBound(Tmp)
        K = K + 1
        If Not Dic.exists(Tmp(J)) Then
            Dic.Add Tmp(J), ""
        End If
    Next
Next
Arr = ArrayListSort(Dic.keys, True)
Txt = Join(Arr, Delimiter)
ListUnique = Txt
Dic.RemoveAll
End Function
Function ArrayListSort(sn As Variant, Optional bAscending As Boolean = True)
    With CreateObject("System.Collections.ArrayList")
        Dim cl As Variant
        For Each cl In sn
            .Add cl
        Next
        .Sort
        If bAscending = False Then .Reverse
        ArrayListSort = .Toarray()
    End With
End Function
Bạn đọc lại code và bỏ các lệnh không quá cần thiết như chuyển range thành mảng và các biến không ảnh hưởng đến kết quả
System.Collections.ArrayList hình như loại trùng được, bỏ Dic code sẽ gọn đẹp hơn
 
Bạn đọc lại code và bỏ các lệnh không quá cần thiết như chuyển range thành mảng và các biến không ảnh hưởng đến kết quả
System.Collections.ArrayList hình như loại trùng được, bỏ Dic code sẽ gọn đẹp hơn
Cảm ơn bác chỉ bảo, cái phần collection em sẽ nghiên cứu sau. Còn cái Range loại bỏ đi và thay thế array trực tiếp vào function thì em loay hoay một lúc nó báo lỗi nên em dẹp luôn :D. Bác hướng dẫn giúp em chỗ này với

Sửa: Có lẽ em không làm được vì loay hoay Function ListUnique(Arr() As Variant, Optional Delimiter As String = ",") thay vì đúng ra là Function ListUnique(Arr As Variant, Optional Delimiter As String = ",")
 
Lần chỉnh sửa cuối:
Excel 365 khoản Function vẫn đuối với Google Sheets quá. :p
=join(",",sort(unique(transpose(split(textjoin(",",true,A2:E2),",")))))
Excel dự tính rằng người sử dụng phải có một trình đọ tối thiểu về cách thiết kế bảng tính.
Google Sheets không dự tính gì cả. Người dùng có thể bắt đầu từ con quỷ một giò và kết thúc với con quỷ 3 giò.
Đối với tôi thì cái khác nhau là người nhận kết quả cuối cùng. Tôi thích nhận kết quả từ người có căn bản thiết kế bảng tính hơn nhận từ người có tài biến hoá dữ liệu.
 
Cảm ơn bác chỉ bảo, cái phần collection em sẽ nghiên cứu sau. Còn cái Range loại bỏ đi và thay thế array trực tiếp vào function thì em loay hoay một lúc nó báo lỗi nên em dẹp luôn :D. Bác hướng dẫn giúp em chỗ này với

Sửa: Có lẽ em không làm được vì loay hoay Function ListUnique(Arr() As Variant, Optional Delimiter As String = ",") thay vì đúng ra là Function ListUnique(Arr As Variant, Optional Delimiter As String = ",")
Đối với bài nầy nên dùng Range
Mã:
Option Explicit
Dim Dic As Object
Function ListUnique(Rng As Range, Optional Delimiter As String = ",")
Dim iItem As Range, Tmp As Variant, j As Long

If Dic Is Nothing Then Set Dic = CreateObject("Scripting.Dictionary")
For Each iItem In Rng
    Tmp = Split(iItem.Value, Delimiter)
    For j = 0 To UBound(Tmp)
        If Not Dic.exists(Tmp(j)) Then Dic.Add Tmp(j), ""
    Next
Next
ListUnique = Join(ArrayListSort(Dic.keys, True), Delimiter)
Dic.RemoveAll
End Function
Nếu dùng Arr As Variant, dùng hàm typename nếu khác "Range" and khác "Variant()" thì Arr=array(Arr)
Dùng For Each iItem In Arr xử lý
 
Mình không có excel 2010 để test, bạn thử công thức tổng quát sau nhé, Nhớ thử Ctrl+Shift+Enter
Giả định các phần tử có thể có độ dài ký tự khác nhau (không nhất thiết phải là 1 ký tự):, ví dụ: A,D,xY,MMM | yYY,C,D,BBBBB, ...

=TEXTJOIN(",",TRUE,TRANSPOSE(UNIQUE(FILTERXML("<t><s>"&SUBSTITUTE(TEXTJOIN(",",TRUE,A2:E2),",","</s><s>")&"</s></t>","//s"))))
 
Excel 2010 chưa có hàm FilterXML anh ạ :(! Các hàng khác thì đã được add
 
Đối với bài nầy nên dùng Range
Mã:
Option Explicit
Dim Dic As Object
Function ListUnique(Rng As Range, Optional Delimiter As String = ",")
Dim iItem As Range, Tmp As Variant, j As Long

If Dic Is Nothing Then Set Dic = CreateObject("Scripting.Dictionary")
For Each iItem In Rng
    Tmp = Split(iItem.Value, Delimiter)
    For j = 0 To UBound(Tmp)
        If Not Dic.exists(Tmp(j)) Then Dic.Add Tmp(j), ""
    Next
Next
ListUnique = Join(ArrayListSort(Dic.keys, True), Delimiter)
Dic.RemoveAll
End Function
Nếu dùng Arr As Variant, dùng hàm typename nếu khác "Range" and khác "Variant()" thì Arr=array(Arr)
Dùng For Each iItem In Arr xử lý
Vậy thì em bỏ luôn dic luôn anh, xét biến nào đã có thì khỏi add ở ArrayListSort bằng .contains(cl) nữa là xong (mặc dù hơi sai với tên của hàm này :D )
Mã:
Option Explicit
Function ListUnique2(Rng As Range, Optional Delimiter As String = ",")
Dim iItem As Range, Tmp As Variant, J As Long, K As Long, Arr()
For Each iItem In Rng
    Tmp = Split(iItem.Value, Delimiter)
    For J = 0 To UBound(Tmp)
        K = K + 1
        ReDim Preserve Arr(1 To K)
        Arr(K) = Tmp(J)
    Next
Next
ListUnique2 = Join(ArrayListSort(Arr, True), Delimiter)
End Function
Private Function ArrayListSort(sn As Variant, Optional bAscending As Boolean = True)
    With CreateObject("System.Collections.ArrayList")
        Dim cl As Variant
        For Each cl In sn
            If Not .contains(cl) Then .Add cl
        Next
        .Sort
        If bAscending = False Then .Reverse
        ArrayListSort = .Toarray()
    End With
End Function
Bài đã được tự động gộp:

Nghĩ lại em sửa nó thế này luôn, không biết số lượng mà nhiều tốc độ ảnh hưởng gì không
(Với lại cái tmp là string không biết tối đa được bao nhiêu)
Mã:
Option Explicit
Function ListUnique2(Rng As Range, Optional Delimiter As String = ",")
Dim iItem As Range, Tmp As String, J As Long
For Each iItem In Rng
    If iItem <> "" Then Tmp = IIf(Tmp = "", iItem.Value, Tmp & "," & iItem.Value)
Next
ListUnique2 = Join(ArrayListSort(Split(Tmp, Delimiter), True), Delimiter)
End Function
Private Function ArrayListSort(sn As Variant, Optional bAscending As Boolean = True)
    With CreateObject("System.Collections.ArrayList")
        Dim cl As Variant
        For Each cl In sn
            If Not .contains(cl) Then .Add cl
        Next
        .Sort
        If bAscending = False Then .Reverse
        ArrayListSort = .Toarray()
    End With
End Function
 
Lần chỉnh sửa cuối:
Vậy thì em bỏ luôn dic luôn anh, xét biến nào đã có thì khỏi add ở ArrayListSort bằng .contains(cl) nữa là xong (mặc dù hơi sai với tên của hàm này :D )
Mã:
Option Explicit
Function ListUnique2(Rng As Range, Optional Delimiter As String = ",")
Dim iItem As Range, Tmp As Variant, J As Long, K As Long, Arr()
For Each iItem In Rng
    Tmp = Split(iItem.Value, Delimiter)
    For J = 0 To UBound(Tmp)
        K = K + 1
        ReDim Preserve Arr(1 To K)
        Arr(K) = Tmp(J)
    Next
Next
ListUnique2 = Join(ArrayListSort(Arr, True), Delimiter)
End Function
Private Function ArrayListSort(sn As Variant, Optional bAscending As Boolean = True)
    With CreateObject("System.Collections.ArrayList")
        Dim cl As Variant
        For Each cl In sn
            If Not .contains(cl) Then .Add cl
        Next
        .Sort
        If bAscending = False Then .Reverse
        ArrayListSort = .Toarray()
    End With
End Function
Bài đã được tự động gộp:

Nghĩ lại em sửa nó thế này luôn, không biết số lượng mà nhiều tốc độ ảnh hưởng gì không
(Với lại cái tmp là string không biết tối đa được bao nhiêu)
Mã:
Option Explicit
Function ListUnique2(Rng As Range, Optional Delimiter As String = ",")
Dim iItem As Range, Tmp As String, J As Long
For Each iItem In Rng
    If iItem <> "" Then Tmp = IIf(Tmp = "", iItem.Value, Tmp & "," & iItem.Value)
Next
ListUnique2 = Join(ArrayListSort(Split(Tmp, Delimiter), True), Delimiter)
End Function
Private Function ArrayListSort(sn As Variant, Optional bAscending As Boolean = True)
    With CreateObject("System.Collections.ArrayList")
        Dim cl As Variant
        For Each cl In sn
            If Not .contains(cl) Then .Add cl
        Next
        .Sort
        If bAscending = False Then .Reverse
        ArrayListSort = .Toarray()
    End With
End Function
Do dùng 2 công cụ khác nhau mới tách thành 2 Function và làm chậm code, giờ chỉ dùng ArrayList chỉ cần 1 Function, gọn hơn và tốc độ nhanh hơn
 
Về cơ bản em cũng không nhất thiết phải sắp xếp theo thứ tự ABC, chỉ cần lấy được dữ liệu là được.
Và mọi đối tượng lấy ra chỉ có 1 kí tự thì code sau có thể tốt hơn:
Mã:
Function LU(rr As Range, Optional De As String = ",") As String
'LU = List Unique
Dim S$, sT$, sKq$, r As Range
For Each r In rr
    S = S & r.Value
    Next
S = Replace(S, " ", "")
If De = "" Then De = ","
S = Replace(S, De, "")
Do Until S = ""
    sT = Left(S, 1)
    sKq = sKq & sT & ","
    S = Replace(S, sT, "")
    Loop
LU = Left(sKq, Len(sKq) - 1)
End Function
 
Web KT

Bài viết mới nhất

Back
Top Bottom