如何使用非连续范围作为 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