Функция Excel - UDF для получения значения суммы с нескольких листов на основе критериев

ProgramBox

Функция Excel — UDF для получения значения суммы с нескольких листов на основе критериев

Post author:admin
Запись опубликована:14 апреля, 2023
Post category:Вопросы по программированию

#arrays #excel #sum #user-defined-functions

#массивы #excel #сумма #определяемые пользователем функции

Вопрос:

У меня есть функция UDF, которая работает аналогично Sumifs, но более сложным способом, она суммирует значение на основе критериев на главном листе и выполняет поиск значения на других листах.

Проблема, с которой я сталкиваюсь, заключается в том, что если я ввожу функцию udf в столбец «C», она выполняет поиск значения на листе «ALPHA» вместо листа «BETA» и та же проблема в других столбцах.

Как настроить код для ссылки на другие листы, если я ввожу UDF в другие столбцы в коде?

если функция UDF введена в столбцы, то следующее должно быть

Столбец A — АЛЬФА
, столбец C — БЕТА, столбец E — ГАММА

в настоящее время у меня есть приведенный ниже код

 Set wks = Sheets("ALPHA")      
lr = wks.Range("I" amp; Rows.Count).End(xlUp).Row
arr = wks.Range("A2", "I" amp; lr)

Public Function ASUM(r As Range) As Double
Application.Volatile
Dim val1, val2, my_sum
Dim i, x, mylen, lr
Dim crit1, crit2, crit3, crit4, crit5, crit6, crit7, crit8, mystring, 
mystring2
Dim T1, T2, T3, T4, T5, T6, T7, T8
Dim arr
Dim wks
Dim c
Dim e

T1 = 26
T2 = T1   1
T3 = T1   2
T4 = T1   3
T5 = T1   4
T6 = T1   5
T7 = T1   6
T8 = T1   7

If InStr(1, r.Offset(, T1), ".") > 0 Then
mylen = Len(r.Offset(, T1))
For x = 1 To mylen
If IsNumeric(Mid(r.Offset(, T1), x, 1)) Then
mystring = mystring amp; Mid(r.Offset(, T1), x, 1)
Else
mystring = mystring amp; " "
End If
Next
mystring2 = Trim(mystring)
val1 = Left(mystring2, InStr(1, mystring2, " ") - 1) * 100
val2 = Right(mystring2, Len(mystring2) - InStr(1, mystring2, " ")) amp; "99"
For i = val1 To val2
crit1 = crit1 amp; i amp; " "
Next
ElseIf InStr(1, r.Offset(, T1), ",") > 0 Then
crit1 = Replace(r.Offset(, T1), ",", " ")
Else
crit1 = r.Offset(, T1).Value
End If
mystring = "": mystring2 = ""

If InStr(1, r.Offset(, T2), ".") > 0 Then
mylen = Len(r.Offset(, T2))
For x = 1 To mylen
If IsNumeric(Mid(r.Offset(, T2), x, 1)) Then
mystring = mystring amp; Mid(r.Offset(, T2), x, 1)
Else
mystring = mystring amp; " "
End If
Next
mystring2 = Trim(mystring)
val1 = Left(mystring2, InStr(1, mystring2, " ") - 1)
val2 = Right(mystring2, Len(mystring2) - InStr(1, mystring2, " "))
For i = val1 To val2
crit2 = crit2 amp; i amp; " "
Next
ElseIf InStr(1, r.Offset(, T2), ",") > 0 Then
crit2 = Replace(r.Offset(, T2), ",", " ")
Else
crit2 = r.Offset(, T2).Value
End If
mystring = "": mystring2 = ""

If InStr(1, r.Offset(, T3), ".") > 0 Then
mylen = Len(r.Offset(, T3))
For x = 1 To mylen
If IsNumeric(Mid(r.Offset(, T3), x, 1)) Then
mystring = mystring amp; Mid(r.Offset(, T3), x, 1)
Else
mystring = mystring amp; " "
End If
Next
mystring2 = Trim(mystring)
val1 = Left(mystring2, InStr(1, mystring2, " ") - 1)
val2 = Right(mystring2, Len(mystring2) - InStr(1, mystring2, " "))
For i = val1 To val2
crit3 = crit3 amp; i amp; " "
Next
ElseIf InStr(1, r.Offset(, T3), ",") > 0 Then
crit3 = Replace(r.Offset(, T3), ",", " ")
Else
crit3 = r.Offset(, T3).Value
End If
mystring = "": mystring2 = ""

If InStr(1, r.Offset(, T4), ".") > 0 Then
mylen = Len(r.Offset(, T4))
For x = 1 To mylen
If IsNumeric(Mid(r.Offset(, T4), x, 1)) Then
mystring = mystring amp; Mid(r.Offset(, T4), x, 1)
Else
mystring = mystring amp; " "
End If
Next
mystring2 = Trim(mystring)
val1 = Left(mystring2, InStr(1, mystring2, " ") - 1)
val2 = Right(mystring2, Len(mystring2) - InStr(1, mystring2, " "))
For i = val1 To val2
crit4 = crit4 amp; i amp; " "
Next
ElseIf InStr(1, r.Offset(, T4), ",") > 0 Then
crit4 = Replace(r.Offset(, T4), ",", " ")
Else
crit4 = r.Offset(, T4).Value
End If
mystring = "": mystring2 = ""

If InStr(1, r.Offset(, T5), ".") > 0 Then
mylen = Len(r.Offset(, T5))
For x = 1 To mylen
If IsNumeric(Mid(r.Offset(, T5), x, 1)) Then
mystring = mystring amp; Mid(r.Offset(, T5), x, 1)
Else
mystring = mystring amp; " "
End If
Next
mystring2 = Trim(mystring)
val1 = Left(mystring2, InStr(1, mystring2, " ") - 1)
val2 = Right(mystring2, Len(mystring2) - InStr(1, mystring2, " "))
For i = val1 To val2
crit5 = crit5 amp; i amp; " "
Next
ElseIf InStr(1, r.Offset(, T5), ",") > 0 Then
crit5 = Replace(r.Offset(, T5), ",", " ")
Else
crit5 = r.Offset(, T5).Value
End If
mystring = "": mystring2 = ""

If InStr(1, r.Offset(, T6), ".") > 0 Then
mylen = Len(r.Offset(, T6))
For x = 1 To mylen
If IsNumeric(Mid(r.Offset(, T6), x, 1)) Then
mystring = mystring amp; Mid(r.Offset(, T6), x, 1)
Else
mystring = mystring amp; " "
End If
Next
mystring2 = Trim(mystring)
val1 = Left(mystring2, InStr(1, mystring2, " ") - 1)
val2 = Right(mystring2, Len(mystring2) - InStr(1, mystring2, " "))
For i = val1 To val2
crit6 = crit6 amp; i amp; " "
Next
ElseIf InStr(1, r.Offset(, T6), ",") > 0 Then
crit6 = Replace(r.Offset(, T6), ",", " ")
Else
crit6 = r.Offset(, T6).Value
End If
mystring = "": mystring2 = ""
.............................................
If InStr(1, r.Offset(, T7), ".") > 0 Then
mylen = Len(r.Offset(, T7))
For x = 1 To mylen
If IsNumeric(Mid(r.Offset(, T7), x, 1)) Then
mystring = mystring amp; Mid(r.Offset(, T7), x, 1)
Else
mystring = mystring amp; " "
End If
Next
mystring2 = Trim(mystring)
val1 = Left(mystring2, InStr(1, mystring2, " ") - 1)
val2 = Right(mystring2, Len(mystring2) - InStr(1, mystring2, " "))
For i = val1 To val2
crit7 = crit7 amp; i amp; " "
Next
ElseIf InStr(1, r.Offset(, T7), ",") > 0 Then
crit7 = Replace(r.Offset(, T7), ",", " ")
Else
crit7 = r.Offset(, T7).Value
End If
mystring = "": mystring2 = ""

If InStr(1, r.Offset(, T8), ".") > 0 Then
mylen = Len(r.Offset(, T8))
For x = 1 To mylen
If IsNumeric(Mid(r.Offset(, T8), x, 1)) Then
mystring = mystring amp; Mid(r.Offset(, T8), x, 1)
Else
mystring = mystring amp; " "
End If
Next
mystring2 = Trim(mystring)
val1 = Left(mystring2, InStr(1, mystring2, " ") - 1)
val2 = Right(mystring2, Len(mystring2) - InStr(1, mystring2, " "))
For i = val1 To val2
crit8 = crit8 amp; i amp; " "
Next
ElseIf InStr(1, r.Offset(, T8), ",") > 0 Then
crit8 = Replace(r.Offset(, T8), ",", " ")
Else
crit8 = r.Offset(, T8).Value
End If

Set wks = Sheets("ALPHA")

lr = wks.Range("I" amp; Rows.Count).End(xlUp).Row
arr = wks.Range("A2", "I" amp; lr)

For i = 1 To UBound(arr)
If InStr(1, crit1, arr(i, 1)) > 0 Or r.Offset(, T1) = "" Or r.Offset(, T1) = "<ALL>" Then
If InStr(1, crit2, arr(i, 2)) > 0 Or r.Offset(, T2) = "" Or r.Offset(, T2) = "<ALL>" Then
If InStr(1, crit3, arr(i, 3)) > 0 Or r.Offset(, T3) = "" Or r.Offset(, T3) = "<ALL>" Then
If InStr(1, crit4, arr(i, 4)) > 0 Or r.Offset(, T4) = "" Or r.Offset(, T4) = "<ALL>" Then
If InStr(1, crit5, arr(i, 5)) > 0 Or r.Offset(, T5) = "" Or r.Offset(, T5) = "<ALL>" Then
If InStr(1, crit6, arr(i, 6)) > 0 Or r.Offset(, T6) = "" Or r.Offset(, T6) = "<ALL>" Then
If InStr(1, crit7, arr(i, 7)) > 0 Or r.Offset(, T7) = "" Or r.Offset(, T7) = "<ALL>" Then
If InStr(1, crit8, arr(i, 8)) > 0 Or r.Offset(, T8) = "" Or r.Offset(, T8) = "<ALL>" Then
my_sum = my_sum   arr(i, UBound(arr, 2))
End If
End If
End If
End If
End If
End If
End If
End If
Next
ASUM = my_sum
End Function

1. Помогите нам помочь вам, разместите свой полный UDF.

2. Как предоставить общий доступ к полному UDF, он слишком длинный, есть ли другой способ поделиться?

3. Мне удалось опубликовать udf, спасибо

Ответ №1:

Оказывается, UDF можно получить информацию о ячейке, из которой она вызывается, используя Application.Caller :

 Dim kaller As Range, n As Long
Set kaller = Application.Caller
 n = kaller.Column
 If n = 1 Then Set ws = Sheets("ALHPA")
 If n = 3 Then Set ws = Sheets("BETA")
 If n = 5 Then Set ws = Sheets("GAMMA")

это должно заменить единственную строку:

 Set wks = Sheets("ALPHA")

Логика может быть расширена, если UDF вызывается из других столбцов.

1. Спасибо, Гэри, я использовал приведенную выше логику и заменил одну строку, однако она отображается как «значение» в ячейках

2. @AnandRaj Могут быть другие проблемы, которые я не могу найти, не имея возможности запустить UDF

3. Привет, Гэри, большое спасибо, ваша логика сработала отлично, приношу извинения с моей стороны за предыдущий комментарий,.