将范围传递给Excel用户定义函数并将其分配给数组

时间:2013-04-11 03:08:08

标签: arrays excel excel-vba range user-defined-functions vba

我正在尝试

  1. 将两个范围 - 多行单列 - 传递给Excel 2007中的用户定义函数,
  2. 然后将其分配给数组进行处理。
  3. 有人能告诉我如何将这样的范围分配给数组吗?

    范围不是恒定的,因为我在不同的单元格中使用UDF来获取不同的数据,所以我不能使用e,g,Range("A1:A10")

    当我只使用Data1.Rows.Cells(i, 1)而不是数组时,代码正常工作。但我认为最好使用一维数组来提高效率。

    这是我目前的代码

    Function Sample(Data1 As Range, Data2 As Range) As Double
    
     'Size of Data1 and Data2
     Dim rows As Integer
     rows = Data1.Rows.Count 
    
     'Declaring two one dimensional arrays
     Dim data1Array(rows) As Double --- Getting error here
     Dim data2Array(rows) As Double --- Getting error here
    
     Dim diff As Double
     Dim average As Double
     Dim i As Integer
    
     'Assigning Range to Array
     data1Array = Data1 --- Getting Error here
     data2Array = Data2 --- Getting Error here
    
     average = 0
     diff = 0
    
     For i = 1 To rows
    
       diff = data1Array(i) - data2Array(i)
    
       If diff < 0 Then
         diff = diff * -1
       End If
    
       average = diff + average
    
     Next i
    
     Sample = average/rows
    
    End Function
    

1 个答案:

答案 0 :(得分:7)

这样的东西适用于1D范围,包括测试

  1. 不等的范围
  2. 单细胞范围(不能使用变体)
  3. 示例子

    Sub Test()
    MsgBox Sample([a1:a3], [a5:a7])
    End Sub
    

    功能

     Function Sample(Data1 As Range, Data2 As Range)
    
     Dim X
     Dim Y
     Dim lngCnt As Long
     Dim dbDiff As Double
     Dim dbAvg As Double
    
     If Data1.rows.Count <> Data2.rows.Count Then
     Sample = "Different range sizes"
     Exit Function
     ElseIf Data1.rows.Count = 1 Then
     Sample = "Single cell range"
     Exit Function
     End If
    
     X = Application.Transpose(Data1)
     Y = Application.Transpose(Data2)
    
     For lngCnt = 1 To UBound(X)
       dbDiff = X(lngCnt) - Y(lngCnt)
       If dbDiff < 0 Then
         dbDiff = dbDiff * -1
       End If
       dbAvg = dbDiff + dbAvg
     Next
    
     Sample = dbAvg / lngCnt
    
    End Function