(解决)VBAarrays大小重置一次打32767(Excel 2010)

我使用一维dynamic数组来保存它们总数为60K以上的值。 这似乎是一个简单的任务,但我注意到,一旦数组的大小达到32767,它又从0开始。 任何build议将不胜感激。

我的代码:

Sub GetHours() Dim R As Long, i As Long, N As Long, var, vRaw, v R = LastUsedRow(Sheet1) With Sheet1 vRaw = .Range(.Cells(2, 1), .Cells(R, 22)).Value End With For i = 1 To R - 1 var = vRaw(i, 12) If IsNumeric(var) Then If IsArrayEmpty(v) Then ReDim v(0) v(0) = i Else N = UBound(v) + 1 ReDim Preserve v(N) v(N) = i End If End If Next End Sub Function LastUsedRow(ByVal ws As Worksheet) As Long Dim lastrow As Long On Error GoTo errHandler lastrow = ws.Cells.Find(What:="*", After:=[A1], _ SearchOrder:=xlByRows, _ SearchDirection:=xlPrevious).Row LastUsedRow = lastrow Exit Function errHandler: LastUsedRow = 0 End Function Function IsArrayEmpty(anArray As Variant) Dim i As Integer On Error Resume Next i = UBound(anArray, 1) If Err.Number = 0 Then IsArrayEmpty = False Else IsArrayEmpty = True End If End Function 

注意你有最后一个IsArrayEmpty函数Dim i As Integer …

这将触发超出~32K的越界错误,这将触发你的arrays被重置。

蒂姆已经解决了主要问题

我会通过使vRaw更小(一列)来使代码更快,
并从For循环中删除数组的ReDim-ing

 Option Explicit Public Sub GetHours() Dim lr As Long, i As Long, j As Long, vRaw As Variant, vArr As Variant lr = LastUsedRow(Sheet1) If lr > 1 Then vRaw = Sheet1.Range(Sheet1.Cells(2, 12), Sheet1.Cells(lr, 12)).Value ReDim vArr(lr - 1) 'max possible size (remove extra work from loop) For i = 1 To lr - 1 If IsNumeric(vRaw(i, 1)) And Len(vRaw(i, 1)) > 0 Then vArr(j) = i '+ 1 (to get the row number including the header) j = j + 1 End If Next ReDim Preserve vArr(j - 1) 'shrink final array to total actual values held End If End Sub Public Function LastUsedRow(ByRef ws As Worksheet) As Long Dim lastRow As Range Set lastRow = ws.Cells.Find(What:="*", After:=[A1], _ SearchOrder:=xlByRows, _ SearchDirection:=xlPrevious) LastUsedRow = IIf(lastRow Is Nothing, 1, lastRow.Row) End Function