Возвращаемые значения, если он больше или меньше определенного значения с использованием UDF

Question

В настоящее время я работаю над UDF, который возвращает и объединяет заголовки, если он больше или меньше определенного значения. Я не очень хорош в Excel-Vba, и то, что я получил до сих пор, - этот жалкий код, который я больше не мог понять. Я бы по достоинству оценил это, если бы кто-то мог помочь. Вот что я получил до сих пор:

Public Function greaterLessValue(Rng As Range, Rng2 As Range, greater, less) 

Dim rngArr() As Variant 
rngArr = Rng.value 

For i = 1 To UBound(rngArr, 1) 
    For j = 1 To UBound(rngArr, 2) 
     If rngArr(i, j) = xVal Then 
      For k = 1 To UBound(rngArr, 2) 
       If rngArr(i, k) = Yval Then countRowAsso = countRowAsso + 1 
      Next k 
     End If 
    Next j 
Next i 

End Function 

Если значение больше или равно 5 и меньше и равно 10 он должен возвращать тот же пример ниже, который сцепляет заголовок, содержащий определенное значение в том же столбце :

Answer 1

A.S.H указывает, что диапазоны содержат одинаковое количество элементов/значений/ячеек. Я использовал другой подход.

Option Explicit 

Public Function greaterLessValue(rng1 As Range, rng2 As Range, _ 
           greater As Double, lesser As Double) 

    Dim i As Long, j As Long 
    Dim rngArr1 As Variant, rngArr2 As Variant 

    rngArr1 = rng1.Value2 
    rngArr2 = rng2.Value2 
    greaterLessValue = "" 

    'use for showing array extents 
    'delete or comment out when function works 
    Debug.Print LBound(rngArr1, 1) & " to " & UBound(rngArr1, 1) 
    Debug.Print LBound(rngArr1, 2) & " to " & UBound(rngArr1, 2) 

    'used to ensure that the ranges hold the same number of columns 
    'only affects the 2nd rank when used with Preserve 
    ReDim Preserve rngArr2(LBound(rngArr1, 1) To UBound(rngArr1, 1), _ 
          LBound(rngArr1, 2) To UBound(rngArr1, 2)) 

    For i = LBound(rngArr1, 1) To UBound(rngArr1, 1) 
     For j = LBound(rngArr1, 2) To UBound(rngArr1, 2) 
      If IsNumeric(rngArr2(i, j)) Then 
       If rngArr2(i, j) >= greater And rngArr2(i, j) <= lesser Then 
        greaterLessValue = greaterLessValue & _ 
             IIf(CBool(Len(greaterLessValue)), ", ", vbNullString) & _ 
             rngArr1(i, j) 
       End If 
      End If 
     Next j 
    Next i 

End Function 

Синтаксис согласно следующему изображению:

Answer 2

Попробуйте UDF:

Public Function greaterLess(values As Range, header As Range, a, b) As String 
    Dim cel As Range 
    For Each cel In values 
     If cel.value >= a And cel.value <= b Then greaterLess = _ 
      greaterLess & header.Cells(1, cel.Column - values.Column + 1) & ", " 
    Next 
End Function 

Использование

Введите следующую формулу в ячейке N2:

=greaterLess(B2:M2, B$1:M$1, 5, 10) 

Затем скопируйте N2, выберите N3:N7 и пасту.

Answer 3

Если у вас есть офис 365 Excel вы можете сделать это с помощью формулы массива:

=TEXTJOIN(", ",TRUE,IF((B2:M2>=5)*(B2:M2<=10),B$1:M$1,"")) 

Будучи формулой массива он должен быть введен с помощью Ctrl-Shift-Enter вместо ввода при выходе из режима редактирования. ЕСЛИ сделано правильно, тогда Excel поместит {} вокруг формулы.

---

Если у вас нет Office 365 Excel, вы можете использовать этот UDF, который будет имитировать функцию.

Function TEXTJOIN(delim As String, skipblank As Boolean, arr) 
    Dim d As Long 
    Dim c As Long 
    Dim arr2() 
    Dim t As Long, y As Long 
    t = -1 
    y = -1 
    If TypeName(arr) = "Range" Then 
     arr2 = arr.Value 
    Else 
     arr2 = arr 
    End If 
    On Error Resume Next 
    t = UBound(arr2, 2) 
    y = UBound(arr2, 1) 
    On Error GoTo 0 

    If t >= 0 And y >= 0 Then 
     For c = LBound(arr2, 1) To UBound(arr2, 1) 
      For d = LBound(arr2, 1) To UBound(arr2, 2) 
       If arr2(c, d) <> "" Or Not skipblank Then 
        TEXTJOIN = TEXTJOIN & arr2(c, d) & delim 
       End If 
      Next d 
     Next c 
    Else 
     For c = LBound(arr2) To UBound(arr2) 
      If arr2(c) <> "" Or Not skipblank Then 
       TEXTJOIN = TEXTJOIN & arr2(c) & delim 
      End If 
     Next c 
    End If 
    TEXTJOIN = Left(TEXTJOIN, Len(TEXTJOIN) - Len(delim)) 
End Function 

Формула та же самая и по-прежнему введена с помощью Ctrl-Shift-Enter вместо Enter.