Cảm ơn bạn đã giúp đỡ.Bạn thử dùng hàm Jointext của bác ndu96081631 xem có được ko?
Chào bạn, Mình đã test thử thấy kết quả đã đúng.Bạn thử dùng hàm Jointext của bác ndu96081631 xem có được ko?
Thật sự với hàm mảng và vba này mình chưa biết áp dụng cách của bạn thế nào nữa...mong được bạn chỉ thêm qua file kèm.
Hàm đó tôi cảm thấy khá rắc rối khi áp dụng, bạn dùng hàm này vậy:
Hàm mảng hay hàm tự tạo cũng có quy luật chung mà bạn, bạn dùng if để biến đổi sẽ cho các kết quả như ý. Ví dụ
=jointext(",",TRUE,IF([COLOR=#ff0000][B]($E$3:$E$20<>"")[/B][/COLOR]*($D$3:$D$20)=G3,$E$3:$E$20,""))Function TextJoin(ByVal ConditionalColumn As Range, _
ByVal ConditionalCell As Range, _
ByVal DataColumn As Range) As String
Dim r As Long
Dim Dict As Object
Dim Item As String, CondCell As String
Dim CondColArr As Variant, DataColArr As Variant
CondCell = ConditionalCell.Value
If IsArray(ConditionalColumn) Then
CondColArr = ConditionalColumn
DataColArr = DataColumn
Else
ReDim CondColArr(1 To 1, 1 To 1)
ReDim DataColArr(1 To 1, 1 To 1)
CondColArr(1, 1) = ConditionalColumn
DataColArr(1, 1) = DataColumn
End If
Set Dict = CreateObject("Scripting.Dictionary")
For r = 1 To UBound(CondColArr)
If CondColArr(r, 1) = CondCell Then
Item = DataColArr(r, 1)
If Not Dict.Exists(Item) And Item > "" Then
Dict.Add Item, Empty
End If
End If
Next
[COLOR=#0000cd][B] If Dict.Count Then[/B][/COLOR]
[COLOR=#0000cd][B] TextJoin = Join(Dict.Keys, ", ")[/B][/COLOR]
[COLOR=#0000cd][B] End If[/B][/COLOR]
End FunctionCảm ơn bạn.
Cảm ơn anh Nghĩa hiện em đang sử dụng hàm mới cập của Anh nhưng chưa thấy lỗi để lập bảng dữ liệu xem có lỗi gì không em sẽ hồi âm lại,còn Dữ liệu này em cũng đã biết rồi. Nhưng cái lỗi mà em nêu ở 922 là đang phát sinh.
Anh chưa ngủ ạ, vậy thì anh xem trường thêm trường hợp này nhé hàm TextJoin nếu định dạng khác nhau thì kết quả cũng sai hả Anh Nghĩa.
Cho tôi hỏi, cột điều kiện luôn luôn là dạng ngày tháng phải không?
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 FunctionFunction 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 = CStr(Item)
n = n + 1
ReDim Preserve Arr(1 To n)
Arr(n) = tmp
End If
Next
Next
If n Then JoinText = Join(Arr, Delimiter)
End Function=JoinIf(", ",$D$3:$D$20,G3,$E$3:$E$20)
Function TextJoin(ByVal ConditionalColumn As Range, _
ByVal ConditionalCell As Range, _
ByVal DataColumn As Range) As String
On Error Resume Next
Dim r As Long
Dim Dict As Object
Dim Item As String, CondCell As Date
Dim CondColArr As Variant, DataColArr As Variant
CondCell = ConditionalCell.Value
If IsArray(ConditionalColumn) Then
CondColArr = ConditionalColumn
DataColArr = DataColumn
Else
ReDim CondColArr(1 To 1, 1 To 1)
ReDim DataColArr(1 To 1, 1 To 1)
CondColArr(1, 1) = ConditionalColumn
DataColArr(1, 1) = DataColumn
End If
Set Dict = CreateObject("Scripting.Dictionary")
For r = 1 To UBound(CondColArr)
If CDate(CondColArr(r, 1)) = CondCell Then
Item = DataColArr(r, 1)
If Not Dict.Exists(Item) And Item > "" Then
Dict.Add Item, Empty
End If
End If
Next
If Dict.Count Then
TextJoin = Join(Dict.Keys, ", ")
End If
End Function=JoinIf(", ",$H$8:$H$100,[COLOR=#ff0000]"="&K8[/COLOR],$I$8:$I$100)Ai lại làm thế! Hàm phải tổng quát chứ
