Vba 如何在Excel中使用2个范围

Vba 如何在Excel中使用2个范围,vba,excel,Vba,Excel,这是我的代码,当我使用1个范围时,它可以工作,但如果我使用2个或更多,它就不工作。 我真的不知道如何修复我的代码。任何帮助都将不胜感激 Function CUSTOMAVERAGE(rng As Range) Dim cell As Range, suma As Double, sk As Double, i As Double, vidurkis As Double, max As Double, dup As Double, dupp As Double, down As Doubl

这是我的代码,当我使用1个范围时,它可以工作,但如果我使用2个或更多,它就不工作。 我真的不知道如何修复我的代码。任何帮助都将不胜感激

    Function CUSTOMAVERAGE(rng As Range)
Dim cell As Range, suma As Double, sk As Double, i As Double, vidurkis As Double, max As Double, dup As Double, dupp As Double, down As Double, downn As Double, text1 As String

 suma = 0
For Each cell In rng
    suma = suma + cell.Value
    sk = sk + 1
Next cell
vidurkis = suma / sk



max = 0
For Each cell In rng
    If max < cell.Value Then
    max = cell.Value
    End If
Next cell
max = max

min = max
For Each cell In rng
    If min > cell.Value Then
    min = cell.Value
    End If
Next cell
min = min

dupp = 0
dup = 0
sk = 0
For Each cell In rng
    If vidurkis < cell.Value Then
    dupp = dupp + cell.Value
    sk = sk + 1
    End If
Next cell
dup = dupp / sk



downn = 0
down = 0
sk = 0
For Each cell In rng
    If vidurkis > cell.Value Then
    downn = downn + cell.Value
    sk = sk + 1
    End If
Next cell
down = downn / sk




text1 = "V=" & CStr(vidurkis) & " Min=" & CStr(min) & " Max=" & CStr(max) & " Dup=" & CStr(dup) & " Ddown=" & CStr(down)
CUSTOMAVERAGE = text1
End Function

任何例子都很好。

试试下面这样的例子:

Option Explicit

Function CUSTOMAVERAGE(ParamArray ranges())
    Dim rng As Range
    Dim part As Variant
    Dim cell As Range
    Dim i As Double
    Dim suma As Double
    Dim sk As Double
    Dim min As Double
    Dim max As Double
    Dim vidurkis As Double
    Dim dup As Double
    Dim sk1 As Double
    Dim ddown As Double
    CUSTOMAVERAGE = CVErr(xlErrNA)
    Set rng = Nothing
    For Each part In ranges
        If TypeName(part) = "Range" Then
            If TypeName(rng) = "Range" Then
                Set rng = Union(rng, part)
            Else
                Set rng = part
            End If
        End If
    Next
    If rng Is Nothing Then Exit Function
    suma = 0
    sk = 0
    min = 1.79769313486231E+308
    max = -1.79769313486231E+308
    For Each cell In rng
        suma = suma + cell.Value
        sk = sk + 1
        If min > cell.Value Then min = cell.Value
        If max < cell.Value Then max = cell.Value
    Next
    vidurkis = suma / sk
    sk = 0
    dup = 0
    sk1 = 0
    ddown = 0
    For Each cell In rng
        If vidurkis < cell.Value Then
            dup = dup + cell.Value
            sk = sk + 1
        ElseIf vidurkis > cell.Value Then
            ddown = ddown + cell.Value
            sk1 = sk1 + 1
        End If
    Next cell
    If sk = 0 Or sk1 = 0 Then Exit Function
    dup = dup / sk
    ddown = ddown / sk1
    CUSTOMAVERAGE = "V=" & CStr(vidurkis) & " Min=" & CStr(min) & " Max=" & CStr(max) & " Dup=" & CStr(dup) & " Ddown=" & CStr(ddown)
End Function

请澄清什么是不工作,以及如何调用此函数?这里似乎有很多不必要的循环。我也不确定我是否遵循了-但如果你想将当前范围扩展到另一个范围-你可以做如下操作:rng=UnionRangeA1:A100,RangeC1:C100也正如@Rory非常正确地说的那样-看起来您的循环太多了,无法高效运行。我的意思是,当我使用这个函数时,I exel=CUSTOMAVERAGEA1:A5;C7:C11它不工作,我得到错误值!当我在一个范围内使用函数like=CUSTOMAVERAGEA1:a5时,它工作得很好。您需要定义函数以获取多个参数。您可以使用可选参数或参数数组。顺便说一句,也许有更好的方法来做你正在尝试的事情,但这至少会让你做你正在尝试的事情。