Excel - UDF 函数，用于根据条件从多个工作表中获取 SUM 值

Posted 2023-04-14

【中文标题】Excel - UDF 函数，用于根据条件从多个工作表中获取 SUM 值

【英文标题】：Excel - UDF Function to get the SUM value from multiple sheets based on criteria

【发布时间】：2020-08-21 11:02:55

【问题描述】：

我有一个 UDF 函数，它的工作原理类似于 Sumifs，但方式更复杂，它根据主表中的条件对值求和，并在其他表中查找值。

我面临的挑战是，如果我在“C”列中输入 udf 函数，它会在工作表“ALPHA”中查找值，而不是工作表“BETA”和其他列中的相同问题。

如果我在代码中的其他列中输入 UDF，如何设置代码以引用其他工作表？

如果在列中输入了UDF函数，那么下面应该是

A 列 - ALPHA C 列 - 测试版 E 列 - GAMMA

目前我有以下代码

Set wks = Sheets("ALPHA")      
lr = wks.Range("I" & Rows.Count).End(xlUp).Row
arr = wks.Range("A2", "I" & 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 & Mid(r.Offset(, T1), x, 1)
Else
mystring = mystring & " "
End If
Next
mystring2 = Trim(mystring)
val1 = Left(mystring2, InStr(1, mystring2, " ") - 1) * 100
val2 = Right(mystring2, Len(mystring2) - InStr(1, mystring2, " ")) & "99"
For i = val1 To val2
crit1 = crit1 & i & " "
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 & Mid(r.Offset(, T2), x, 1)
Else
mystring = mystring & " "
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 & i & " "
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 & Mid(r.Offset(, T3), x, 1)
Else
mystring = mystring & " "
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 & i & " "
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 & Mid(r.Offset(, T4), x, 1)
Else
mystring = mystring & " "
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 & i & " "
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 & Mid(r.Offset(, T5), x, 1)
Else
mystring = mystring & " "
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 & i & " "
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 & Mid(r.Offset(, T6), x, 1)
Else
mystring = mystring & " "
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 & i & " "
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 & Mid(r.Offset(, T7), x, 1)
Else
mystring = mystring & " "
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 & i & " "
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 & Mid(r.Offset(, T8), x, 1)
Else
mystring = mystring & " "
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 & i & " "
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" & Rows.Count).End(xlUp).Row
arr = wks.Range("A2", "I" & 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

【问题讨论】：

帮助我们为您提供帮助，发布您的完整 UDF。

如何分享完整的UDF，太长了，有没有其他的分享方式？

我设法发布了 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，则可以扩展逻辑。

【讨论】：

谢谢加里，我已经使用了上述逻辑并替换了单行，但是它在单元格中显示为“值”

@AnandRaj 如果无法运行UDF，我可能还找不到其他问题

你好，加里，非常感谢，你的逻辑运行良好，我为之前的评论道歉，。