如何使用非连续范围作为 excel 函数的参数
How to use non-continuous ranges as parameters of excel function
我在使用非连续范围作为 excel 函数的参数时遇到了一个令人沮丧的问题(如斜率(range_y,range_x)),我应该怎么做?!我试过为范围定义名称或将范围放在括号中。但它不起作用,我遇到了#value 错误。我也试过间接功能,但没有取得成功。即使在 vba 我也无法解决这个问题。请帮我。
这是我的代码:
Sub Do_Interpolate_Extrapolate()
Dim X_range,Y_range As Range
Dim a_TestCell As Range
Dim FStr as String
Dim Lin_a as double
....
Set X_range = Union(Range("V6:V7"), Range("V9:V12"), Range("V14"), Range("V17:V18"))
Set Y_range = Union(Range("T6:T7"), Range("T9:T12"), Range("T14"), Range("T17:T18"))
Set a_TestCell =Range("A2")
....
FStr = "=SLOPE(" & Y_range.Address & "," & X_range.Address & ")"
a_TestCell.Formula = FStr
Lin_a = CDbl(a_TestCell.Value)
a_TestCell.ClearContents
MsgBox "Lin_a =" & Lin_a
....
End sub
运行 此代码我收到运行时错误“1004”,提示应用程序定义或对象定义错误!
请尝试下一个代码。 Slope
需要连续范围。返回一个不连续的范围地址,就像它的用逗号分隔的区域一样,公式将每个区域解释为一个参数和 'finds' 太多:
Sub Do_Interpolate_Extrapolate_Array()
Dim X_range As Range, Y_range As Range
Dim Lin_a As Double, colNo As Long, arrX, arrY
Dim tempRngX As Range, tempRngY As Range 'temporary ranges to be created and used to calculate the slope
colNo = ActiveSheet.UsedRange.Columns.count 'the sheet existing number of columns
Set X_range = Union(Range("V6:V7"), Range("V9:V12"), Range("V14"), Range("V17:V18"))
Set Y_range = Union(Range("T6:T7"), Range("T9:T12"), Range("T14"), Range("T17:T18"))
arrX = contArrayFromDscRng(X_range) 'put the content of the discontinuous range in a continuous array
arrY = contArrayFromDscRng(Y_range) 'put the content of the discontinuous range in a continuous array
cells(1, colNo + 1).Resize(UBound(arrX), 1).value = arrX 'drop the X array in the first column after the last
cells(1, colNo + 2).Resize(UBound(arrY), 1).value = arrY 'drop the Y array in the second column after the last
Set tempRngX = Range(cells(1, colNo + 1), cells(UBound(arrX), colNo + 1)) 'set the temporary X range
Set tempRngY = Range(cells(1, colNo + 2), cells(UBound(arrY), colNo + 2)) 'set the temporary Y range
Lin_a = WorksheetFunction.Slope(tempRngX, tempRngY) 'calculate the Slope using the temporary ranges
tempRngX.Clear: tempRngY.Clear 'clear the temporary ranges
MsgBox "Lin_a =" & Lin_a 'return the calculated Slope
End Sub
Private Function contArrayFromDscRng(rng As Range) As Variant 'makes an array from a discontinuous range
Dim a As Range, arr, count As Long, i As Long
ReDim arr(1 To rng.cells.count, 1 To 1): count = 1
For Each a In rng.Areas
For i = 1 To a.cells.count
arr(count, 1) = a.cells(i).value: count = count + 1
Next
Next
contArrayFromDscRng = arr
End Function
已编辑:
使用(仅)数组的变体(感谢 Chris 和他使用 Value2
而不是 Value
的想法 - 在函数中:
Sub Do_Interpolate_Extrapolate_Array2()
Dim X_range As Range, Y_range As Range
Dim Lin_a As Double, colNo As Long, arrX, arrY
colNo = ActiveSheet.UsedRange.Columns.count 'the sheet existing number of columns
Set X_range = Union(Range("V6:V7"), Range("V9:V12"), Range("V14"), Range("V17:V18"))
Set Y_range = Union(Range("T6:T7"), Range("T9:T12"), Range("T14"), Range("T17:T18"))
arrX = contArrayFromDscRng(X_range) 'put the content of the discontinuous range in a continuous array
arrY = contArrayFromDscRng(Y_range) 'put the content of the discontinuous range in a continuous array
Lin_a = WorksheetFunction.Slope(arrX, arrY) 'calculate the slope using arrays
MsgBox "Lin_a =" & Lin_a 'return the calculated Slope
End Sub
更快、更紧凑、更好...
基于 Fanes 的回答
SLOPE
将接受范围、二维数组(单行或单列)或一维数组 (在 Excel365 中测试)
SLOPE
参数为known_y's, known_x's
这是一个使用向量的解决方案
Sub Do_Interpolate_Extrapolate_Array()
Dim X_range As Range
Dim Y_range As Range
Dim Lin_a As Double
Dim arrX As Variant
Dim arrY As Variant
Set X_range = Union(Range("V6:V7"), Range("V9:V12"), Range("V14"), Range("V17:V18"))
Set Y_range = Union(Range("T6:T7"), Range("T9:T12"), Range("T14"), Range("T17:T18"))
'put the content of the non-contiguous ranges in single vectors
arrX = VectorFromRange(X_range)
arrY = VectorFromRange(Y_range)
'calculate the Slope using the vectors
Lin_a = WorksheetFunction.Slope(arrY, arrX)
'return the calculated Slope
MsgBox "Lin_a =" & Lin_a
End Sub
Private Function VectorFromRange(rng As Range) As Variant
Dim arr As Variant
Dim ar As Range
Dim cnt As Long
Dim i As Long
ReDim arr(1 To rng.Cells.Count)
For Each ar In rng.Areas
For i = 1 To ar.Cells.Count
cnt = cnt + 1
arr(cnt) = ar.Cells(i).Value2
Next
Next
VectorFromRange = arr
End Function
我在使用非连续范围作为 excel 函数的参数时遇到了一个令人沮丧的问题(如斜率(range_y,range_x)),我应该怎么做?!我试过为范围定义名称或将范围放在括号中。但它不起作用,我遇到了#value 错误。我也试过间接功能,但没有取得成功。即使在 vba 我也无法解决这个问题。请帮我。 这是我的代码:
Sub Do_Interpolate_Extrapolate()
Dim X_range,Y_range As Range
Dim a_TestCell As Range
Dim FStr as String
Dim Lin_a as double
....
Set X_range = Union(Range("V6:V7"), Range("V9:V12"), Range("V14"), Range("V17:V18"))
Set Y_range = Union(Range("T6:T7"), Range("T9:T12"), Range("T14"), Range("T17:T18"))
Set a_TestCell =Range("A2")
....
FStr = "=SLOPE(" & Y_range.Address & "," & X_range.Address & ")"
a_TestCell.Formula = FStr
Lin_a = CDbl(a_TestCell.Value)
a_TestCell.ClearContents
MsgBox "Lin_a =" & Lin_a
....
End sub
运行 此代码我收到运行时错误“1004”,提示应用程序定义或对象定义错误!
请尝试下一个代码。 Slope
需要连续范围。返回一个不连续的范围地址,就像它的用逗号分隔的区域一样,公式将每个区域解释为一个参数和 'finds' 太多:
Sub Do_Interpolate_Extrapolate_Array()
Dim X_range As Range, Y_range As Range
Dim Lin_a As Double, colNo As Long, arrX, arrY
Dim tempRngX As Range, tempRngY As Range 'temporary ranges to be created and used to calculate the slope
colNo = ActiveSheet.UsedRange.Columns.count 'the sheet existing number of columns
Set X_range = Union(Range("V6:V7"), Range("V9:V12"), Range("V14"), Range("V17:V18"))
Set Y_range = Union(Range("T6:T7"), Range("T9:T12"), Range("T14"), Range("T17:T18"))
arrX = contArrayFromDscRng(X_range) 'put the content of the discontinuous range in a continuous array
arrY = contArrayFromDscRng(Y_range) 'put the content of the discontinuous range in a continuous array
cells(1, colNo + 1).Resize(UBound(arrX), 1).value = arrX 'drop the X array in the first column after the last
cells(1, colNo + 2).Resize(UBound(arrY), 1).value = arrY 'drop the Y array in the second column after the last
Set tempRngX = Range(cells(1, colNo + 1), cells(UBound(arrX), colNo + 1)) 'set the temporary X range
Set tempRngY = Range(cells(1, colNo + 2), cells(UBound(arrY), colNo + 2)) 'set the temporary Y range
Lin_a = WorksheetFunction.Slope(tempRngX, tempRngY) 'calculate the Slope using the temporary ranges
tempRngX.Clear: tempRngY.Clear 'clear the temporary ranges
MsgBox "Lin_a =" & Lin_a 'return the calculated Slope
End Sub
Private Function contArrayFromDscRng(rng As Range) As Variant 'makes an array from a discontinuous range
Dim a As Range, arr, count As Long, i As Long
ReDim arr(1 To rng.cells.count, 1 To 1): count = 1
For Each a In rng.Areas
For i = 1 To a.cells.count
arr(count, 1) = a.cells(i).value: count = count + 1
Next
Next
contArrayFromDscRng = arr
End Function
已编辑:
使用(仅)数组的变体(感谢 Chris 和他使用 Value2
而不是 Value
的想法 - 在函数中:
Sub Do_Interpolate_Extrapolate_Array2()
Dim X_range As Range, Y_range As Range
Dim Lin_a As Double, colNo As Long, arrX, arrY
colNo = ActiveSheet.UsedRange.Columns.count 'the sheet existing number of columns
Set X_range = Union(Range("V6:V7"), Range("V9:V12"), Range("V14"), Range("V17:V18"))
Set Y_range = Union(Range("T6:T7"), Range("T9:T12"), Range("T14"), Range("T17:T18"))
arrX = contArrayFromDscRng(X_range) 'put the content of the discontinuous range in a continuous array
arrY = contArrayFromDscRng(Y_range) 'put the content of the discontinuous range in a continuous array
Lin_a = WorksheetFunction.Slope(arrX, arrY) 'calculate the slope using arrays
MsgBox "Lin_a =" & Lin_a 'return the calculated Slope
End Sub
更快、更紧凑、更好...
基于 Fanes 的回答
SLOPE
将接受范围、二维数组(单行或单列)或一维数组 (在 Excel365 中测试)SLOPE
参数为known_y's, known_x's
这是一个使用向量的解决方案
Sub Do_Interpolate_Extrapolate_Array()
Dim X_range As Range
Dim Y_range As Range
Dim Lin_a As Double
Dim arrX As Variant
Dim arrY As Variant
Set X_range = Union(Range("V6:V7"), Range("V9:V12"), Range("V14"), Range("V17:V18"))
Set Y_range = Union(Range("T6:T7"), Range("T9:T12"), Range("T14"), Range("T17:T18"))
'put the content of the non-contiguous ranges in single vectors
arrX = VectorFromRange(X_range)
arrY = VectorFromRange(Y_range)
'calculate the Slope using the vectors
Lin_a = WorksheetFunction.Slope(arrY, arrX)
'return the calculated Slope
MsgBox "Lin_a =" & Lin_a
End Sub
Private Function VectorFromRange(rng As Range) As Variant
Dim arr As Variant
Dim ar As Range
Dim cnt As Long
Dim i As Long
ReDim arr(1 To rng.Cells.Count)
For Each ar In rng.Areas
For i = 1 To ar.Cells.Count
cnt = cnt + 1
arr(cnt) = ar.Cells(i).Value2
Next
Next
VectorFromRange = arr
End Function