Vba 如何在Excel中使用2个范围
这是我的代码,当我使用1个范围时,它可以工作,但如果我使用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
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时,它工作得很好。您需要定义函数以获取多个参数。您可以使用可选参数或参数数组。顺便说一句,也许有更好的方法来做你正在尝试的事情,但这至少会让你做你正在尝试的事情。