Excel - UDF Function 根據條件從多個工作表中獲取 SUM 值

Question

我有一個 UDF function，它的工作方式與 Sumifs 類似，但采用更復雜的方式，它根據主工作表中的條件對值求和，然后在另一張工作表中查找該值。

我面臨的挑戰是，如果我在“C”列中輸入 udf function，它會在工作表“ALPHA”中查找值，而不是工作表“BETA”和其他列中的相同問題。

如果我在代碼中的其他列中輸入 UDF inn，如何設置代碼以引用其他工作表？

如果在列中輸入 UDF function 那么下面應該是

A 列 - 阿爾法
列 C - BETA 列 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

Answer 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，則可以擴展邏輯。