How to write a formula for conditional multiple returns to display in an ordered list in a single cell?

answered 2012-07-21 18:51:31 +0200

JohnSUN
2338 ● 2 ● 23 ● 36
http://wmstrong.ru/

updated 2012-08-02 08:23:18 +0200

Try this solution - ConcatenateRange.ods

In case the file will be not available for download, cite the full text of user-defined function:

Option Explicit ' All variables are declared explicitly in terms of "Dim".
Option Base 0   ' Each array indexing starts at zero

Function concRng(Optional sourceRng As Variant, Optional condRng As Variant, _
                Optional separatorCells As String, Optional separatorRows As String)  As String
Dim i&, j&, min&, max&, count&
Dim tn As String    ' TypeName of input parameter
Dim sArr() As String    ' a temporary array for intermediate results
Dim Arr() As String ' a temporary array - singl row from sourceRng
Const defaultRes = ""   ' You can write custom message on the error parameters, e.g. "Wrong parm - "
Const defaultCellsSep = " "
Const defaultRowsSep = " "
REM First, process the last two parameters, which may not affect anything, 
REM but only need for decorating the result.
REM If they are missing set to their default values
    If IsMissing(separatorCells) Then separatorCells = defaultCellsSep
    If IsMissing(separatorRows) Then separatorRows = defaultRowsSep
    concRng = defaultRes
    If IsMissing(sourceRng) Then Exit Function  ' No params - nothing to do
REM The first parameter is specified. What is this?
    If IsArray(sourceRng) Then  ' Good! This is what we expected! The remaining variants - boring mistakes
        min = LBound(sourceRng,1)
        max = UBound(sourceRng,1)
REM What is it second parameter?
        If IsMissing(condRng) Then ' No param - just join in a single line all the values ​​of the first parameter
            ReDim sArr(min To max)
            For i = min To max
                ReDim Arr(LBound(sourceRng,2) To UBound(sourceRng,2))
                For j = LBound(sourceRng,2) To UBound(sourceRng,2)
                    Arr(j) = CStr(sourceRng(i, j))  ' Convert any value to string
                Next j
                sArr(i) = Join(Arr, separatorCells) ' Concatenate it
            Next i
            concRng = Join(sArr, separatorRows) ' Concatenate result
        Else    ' condRng present
            If IsArray(condRng) Then    ' OK - this is an array. What it is the dimension?
                If UBound(condRng,1) < max Then max = UBound(condRng,1)
                ReDim sArr(min To max)
                count = min-1
                For i = min To max
REM Doing the same thing, but only if the condition is TRUE
                    If condRng(i,LBound(condRng,2)) Then
                        count = count+1
                        ReDim Arr(LBound(sourceRng,2) To UBound(sourceRng,2))
                        For j = LBound(sourceRng,2) To UBound(sourceRng,2)
                            Arr(j) = CStr(sourceRng(i, j))
                        Next j
                        sArr(count) = Join(Arr, separatorCells)
                    EndIf
                Next i
                If count > 0 Then
                    ReDim Preserve sArr(min To count)
                    concRng = Join(sArr, separatorRows)
                Else
                    concRng = defaultRes
                EndIf
            Else    ' condRng not array. You can write your own variant of code for this case. I just fixed the error
                concRng = "Enter this formula as an array function - Ctrl+Shift+Enter"
            EndIf
        EndIf
    Else    ' Not array, singl value? And what to do now?
        concRng = defaultRes + CStr(sourceRng)
    EndIf
End Function