Giúp em hàm concatenate and remove duplicates excel2007

[hoangson8768]

Em có một dãy giá trị ở cột A và nhiều giá trị trùng lặp, em muốn ghép các giá trị thành 1 chuỗi cách nhau bằng dấu ";" em sử dụng CONCATENATE thì phải chọn từng ô và không auto được cho các trường hơp sau, em muốn kết hợp Remove Duplicates khi gặp nhưng giá trị trùng lặp nó tự loại bỏ không nhập vào chuỗi
Moi ngưởi giúp em vấn để này nhé. Thanks!

 

[hoangson8768]

không có thầy nào giúp em à

 

[ndu96081631]

Em có một dãy giá trị ở cột A và nhiều giá trị trùng lặp, em muốn ghép các giá trị thành 1 chuỗi cách nhau bằng dấu ";" em sử dụng CONCATENATE thì phải chọn từng ô và không auto được cho các trường hơp sau, em muốn kết hợp Remove Duplicates khi gặp nhưng giá trị trùng lặp nó tự loại bỏ không nhập vào chuỗi
Moi ngưởi giúp em vấn để này nhé. Thanks!

- Thứ nhất xin hỏi lại: Tại sao kết quả của bạn lại không lấy giá trị A6, A10 và A11
- Thứ hai xin khẳng định: Bài này chỉ có thể dùng VBA vì không có công thức nào có thể giải quyết bài toán nối chuổi có điều kiện cả

 

[hoangson8768]

- Em lấy ví dụ thế thôi thực ra là phải lấy hết cả A6, A10, A11
- Thầy có thể viết 1 VBA cho em được không ạ
thanks thầy

 

[ndu96081631]

- Em lấy ví dụ thế thôi thực ra là phải lấy hết cả A6, A10, A11
- Thầy có thể viết 1 VBA cho em được không ạ
thanks thầy

Có hàng đống cách để làm bài này bằng VBA. Xin gửi lên toàn bộ các code có khả năng ứng dụng:
1> Hàm 1

Function UniqueList(ParamArray sArray())
  Dim Item, tmpArr, SubArr, tmp
  'On Error Resume Next
  With CreateObject("Scripting.Dictionary")
    For Each SubArr In sArray
      tmpArr = SubArr
      If Not IsArray(tmpArr) Then tmpArr = Array(tmpArr)
      For Each Item In tmpArr
        tmp = CStr(Item)
        If Len(tmp) Then
          If Not .Exists(tmp) Then .Add tmp, ""
        End If
      Next
    Next
    If .Count Then UniqueList = .Keys
  End With
End Function

2> Hàm 2

Function JoinText(ByVal Delimiter As String, ParamArray Arrays()) As String
  Dim aTmp, Arr(), Item, tmp As String
  Dim i As Long, n As Long
  'On Error Resume Next
  For i = LBound(Arrays) To UBound(Arrays)
    aTmp = Arrays(i)
    If Not IsArray(aTmp) Then aTmp = Array(aTmp)
    For Each Item In aTmp
      If TypeName(Item) <> "Error" Then
        tmp = Trim(CStr(Item))
        If Len(tmp) Then
          n = n + 1
          ReDim Preserve Arr(1 To n)
          Arr(n) = tmp
        End If
      End If
    Next
  Next
  If n Then JoinText = Join(Arr, Delimiter)
End Function

3> Hàm 3:

Function JoinIf(ByVal Delimiter As String, ByVal CriteriaArray, ByVal Criteria, Optional ByVal TargetArray) As String
  Dim aTmpCrit, aTmpDes, tmp1, tmp2, Arr(), dic As Object
  Dim bComp As Boolean, Chk As Boolean
  Dim i As Long, j As Long, k As Long, dTmpVal As Double
  Set dic = CreateObject("Scripting.Dictionary")
  If IsMissing(TargetArray) Then TargetArray = CriteriaArray
  aTmpCrit = ConvertTo1DArray(CriteriaArray)
  aTmpDes = ConvertTo1DArray(TargetArray)
  If (Not IsArray(aTmpCrit)) Or (Not IsArray(aTmpDes)) Then Exit Function
  On Error Resume Next
  bComp = (InStr("<>=", Left(Criteria, 1)) > 0)
  For i = LBound(aTmpDes) To UBound(aTmpDes)
    tmp1 = aTmpCrit(i): tmp2 = aTmpDes(i)
    If bComp And Len(Criteria) Then
      dTmpVal = CDbl(aTmpCrit(i))
      If Evaluate(dTmpVal & Criteria) Then dic.Add tmp2, ""
    Else
      If (Left(Criteria, 1) = "!") Then
        If Not (UCase(tmp1) Like UCase(Mid(Criteria, 2, Len(Criteria)))) Then dic.Add tmp2, ""
      Else
        If (UCase(tmp1) Like UCase(Criteria)) Then dic.Add tmp2, ""
      End If
    End If
  Next
  If dic.Count Then
    Arr = dic.Keys
    JoinIf = Join(Arr, Delimiter)
  End If
End Function

4> Hàm 4:

Private Function ConvertTo1DArray(ByVal SourceArray)
  Dim aTmp, Item, Arr()
  Dim n As Long
  On Error Resume Next
  aTmp = SourceArray
  If Not IsArray(aTmp) Then aTmp = Array(aTmp)
  For Each Item In aTmp
    n = n + 1
    ReDim Preserve Arr(1 To n)
    Arr(n) = Item
  Next
  ConvertTo1DArray = Arr
End Function

--------------------------
Áp dụng:
1> Giả sử bạn muốn dùng hàm 2 (JoinText) để giải quyết, bạn gõ nó lên bảng tính như sau:

=JoinText("; ",IF(MATCH(A3:A20,A3:A20,0)=ROW(INDIRECT("1:"&ROWS(A3:A20))),A3:A20,""))

Yêu cầu: Gõ xong công thức trên phải kết thúc bằng tổ hợp phím Ctrl + Shift + Enter (vì đó là công thức mảng)
2> Giả sử bạn muốn dùng hàm 3 (JoinIf)để giải quyết, bạn gõ nó lên bảng tính như sau:

=JoinIf("; ", A3:A20,"!")

Yêu cầu: Muốn dùng JoinIf thì bạn phải copy thêm hàm 4 (ConvertTo1DArray) vào chung Module
2> Giả sử bạn muốn dùng hàm 1 (UniqueList) và hàm 2 (JoinText) để giải quyết, bạn gõ nó lên bảng tính như sau:

=JoinText("; ",UniqueList(A3:A20))

Yêu cầu: Vì kết hợp 2 hàm nên điều đương nhiên phải copy cả 2 hàm cho vào 1 Module
vân vân...
Nói chung: Muốn công thức trên bảng tính ngắn gọn thì bạn phải tốn nhiều code và ngược lại
Đưa lên 1 vài cách, tùy ý bạn lựa chọn

 

[hoangson8768]

cảm ơn thầy rất nhiều