如何在Excel中使用两个区域

Question

这是我的代码，当我使用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

任何一个例子都是很棒的。

Answer 1

尝试如下所示：

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