Excel VBA范围调整大小限制?

时间:2013-10-19 02:40:37

标签: excel vba excel-vba resize range

我正在使用VBA来计算成对斜率,将它们存储在一个数组中,然后使用Chip Pearson的技术在工作表上对数组进行转置以对它们进行排序。当斜率数超过65K时,我的代码失败,这在Excel 2003中是有意义的,因为行数。我认为它可以在Excel 2010中使用,但我似乎有同样的问题。有谁知道Resize属性或Transpose方法是否有限制?

由于

Sub pairwise()
Dim endrow As Long, i As Long, j As Long, s As Long
Dim num As Double, denom As Double, sij As Double
Dim r As Range
Dim slopes()

endrow = Range("A1").End(xlDown).Row
n = endrow - 1
nrd = endrow * n / 2
ReDim slopes(nrd)
Debug.Print LBound(slopes); UBound(slopes)
For i = 1 To n
For j = (i + 1) To endrow
    num = Cells(i, 2).Value - Cells(j, 2).Value
    denom = Cells(i, 1).Value - Cells(j, 1).Value
    If denom <> 0 Then
        sij = num / denom
        slopes(s) = sij
        s = s + 1
    End If
Next j
Next i

Set r = Range("C1").Resize(UBound(slopes) - LBound(slopes) + 1, 1)
    r = Application.Transpose(slopes)

    ' sort the range
    r.Sort key1:=r, order1:=xlAscending, MatchCase:=False
End Sub

2 个答案:

答案 0 :(得分:1)

这是Transpose方法的限制。

我的建议是从头开始将数组声明为2D

Redim Slopes(1 To nrd, 1 To 1)

此外,您应该使用Variant Array方法而不是循环For循环中的单元格

答案 1 :(得分:1)

我发现了INDEX功能的相同限制。 http://dailydoseofexcel.com/archives/2013/10/11/worksheetfunction-index-limitations/

以下是如何使输出数组成为二维数组并同时读入所有值而不是循环内部。

Sub pairwise()

    Dim lEndRow As Long
    Dim vaValues As Variant
    Dim aSlopes() As Variant
    Dim lCnt As Long
    Dim rOutput As Range
    Dim i As Long, j As Long

    'A 2d array here can easily be written to a sheet
    lEndRow = Sheet3.Range("a1").End(xlDown).Row
    ReDim aSlopes(1 To lEndRow * (lEndRow - 1), 1 To 1)

    'Create a two-d array of all the values
    vaValues = Sheet3.Range("A1").Resize(lEndRow, 2).Value

    'Loop through the array rather than the cells
    For i = LBound(vaValues, 1) To UBound(vaValues, 1) - 1
        For j = 1 + 1 To UBound(vaValues, 1)
            If vaValues(i, 1) <> vaValues(j, 1) Then
                lCnt = lCnt + 1
                aSlopes(lCnt, 1) = (vaValues(i, 2) - vaValues(j, 2)) / (vaValues(i, 1) - vaValues(j, 1))
            End If
        Next j
    Next i

    'Output the array to a range, and sort
    Set rOutput = Sheet3.Range("C1").Resize(UBound(aSlopes, 1), UBound(aSlopes, 2))
    rOutput.Value = aSlopes
    rOutput.Sort rOutput.Cells(1), xlAscending, , , , , , , , False

End Sub