Dò tìm theo nhiều điều kiện, sắp xếp các giá trị tìm được trong một cell

[Hong.Van]

Em chào Thầy cô & anh chị!
Giúp em cthức trong một Quý (năm 4 quý) dò tìm theo nhiều điều kiện rồi sắp xếp các giá trị tìm được trong một cell cách nhau bởi dấu fẩy hoặc gạch ngang
Em có mô tả trong File đính kèm
Em cảm ơn!

 

[ndu96081631]

Em chào Thầy cô & anh chị!
Giúp em cthức trong một Quý (năm 4 quý) dò tìm theo nhiều điều kiện rồi sắp xếp các giá trị tìm được trong một cell cách nhau bởi dấu fẩy hoặc gạch ngang
Em có mô tả trong File đính kèm
Em cảm ơn!

Nếu chỉ nối chuổi theo điều kiện thì không khó...
Vấn đề là những số HĐ liên tục nhau thì chỉ lấy cái đầu và cái cuối, ở giữa là dấu "-" ---> Cái này hơi mệt à nha
Hỏi lại: Thực chất số HĐ của bạn luôn luôn là number à? Có khi nào nó có chưa các ký tự AlphaB trong đó không? (vì nếu có lại càng mệt)

 

[Hong.Van]

Nếu chỉ nối chuổi theo điều kiện thì không khó...
Vấn đề là những số HĐ liên tục nhau thì chỉ lấy cái đầu và cái cuối, ở giữa là dấu "-" ---> Cái này hơi mệt à nha
Hỏi lại: Thực chất số HĐ của bạn luôn luôn là number à? Có khi nào nó có chưa các ký tự AlphaB trong đó không? (vì nếu có lại càng mệt)

Dấu "-" là quy định của fần mềm của Thuế
HĐ của em là Number
Em cảm ơn!

 

[ndu96081631]

Dấu "-" là quy định của fần mềm của Thuế
HĐ của em là Number
Em cảm ơn!

Trước đây tôi có viết hàm JoinText, giờ sửa lại tí

Function ConsolBill(ParamArray sArray()) As String
  Dim tmpArr, SubArr, Arr(), aSort, Item, aRes()
  Dim n As Long, i As Long, lNextBill As Long, k As Long, pos As Long
  Dim tmp As String, Sep As String
  'On Error Resume Next
  Sep = ","
  For Each SubArr In sArray
    tmpArr = SubArr
    If TypeName(tmpArr) <> "Variant()" Then
      tmp = IIf(TypeName(tmpArr) = "Error", "", Trim(CStr(tmpArr)))
      If Len(tmp) Then
        n = n + 1
        ReDim Preserve Arr(1 To n)
        Arr(n) = tmp
      End If
    Else
      For Each Item In tmpArr
        tmp = IIf(TypeName(Item) = "Error", "", Trim(CStr(Item)))
        If Len(tmp) Then
          n = n + 1
          ReDim Preserve Arr(1 To n)
          Arr(n) = tmp
        End If
      Next
    End If
  Next
  If n Then
    aSort = Sort1DArray(Arr, False, False)
    For i = LBound(aSort) To UBound(aSort)
      If CLng(aSort(i)) <> lNextBill Then
        k = k + 1
        ReDim Preserve aRes(1 To k)
        aRes(k) = aSort(i)
      Else
        If InStr(1, aRes(k), "-") Then
          pos = InStr(1, aRes(k), "-")
          aRes(k) = Left(aRes(k), pos) & aSort(i)
        Else
          aRes(k) = aRes(k) & "-" & aSort(i)
        End If
      End If
      lNextBill = CLng(aSort(i)) + 1
    Next
    If k Then ConsolBill = Join(aRes, Sep)
  End If
End Function

Hàm hổ trợ:

Function Sort1DArray(ByVal Arr, Optional ByVal isText As Boolean = False, Optional ByVal isDESC As Boolean = False)
  Dim sCommand As String
  sCommand = "('" & Join(Arr, vbBack) & "').split('" & vbBack & "').sort("
  If isText Then
    sCommand = sCommand & ")"
  Else
    sCommand = sCommand & "function(a,b){return (a-b)})"
  End If
  If isDESC Then sCommand = sCommand & ".reverse()"
  sCommand = sCommand & ".join('" & vbBack & "')"
  With CreateObject("MSScriptControl.ScriptControl")
    .Language = "JavaScript"
    Sort1DArray = Split(.Eval(sCommand), vbBack)
  End With
End Function

Công thức tại L31:

=consolBill(IF(($D$20:$D$66=$K31)*(INT((MONTH($F$20:$F$66)-1)/3)=2)*($G$20:$G$66="HỦY"),$E$20:$E$66,""))

Công thức mảng nha!
-------------------------
Không biết còn gì trục trặc không? ---> Xem file nhé