dynamic地维度/填充二维数组

我有一个有趣的问题。 我需要用数据填充二维数组，但是我不知道有多less个数据点存在，直到数组被填充。

Dim finalArray(0 to 500000, 0 to 3) R=0 For Each index in someDictionary If Not someDictionary.item(index)(1) = 0 finalArray(R,0) = someDictionary.item(index)(1) finalArray(R,1) = someDictionary.item(index)(2) finalArray(R,2) = someDictionary.item(index)(3) R = R + 1 End If Next index 

问题是我不知道词典中有多less项目，也不知道有多less项目是非零的。 我知道的唯一方法是在我运行循环并计数R之后

目前我正在将整个500k行数组打印到Excel中，这通常是100-400k行的数据，其余的空白。 这是不明智的，我想重新维度数组是正确的大小。 我不能使用ReDim因为我不能删除数据，我不能使用ReDim Preserve因为它是二维的，我需要减less行数，而不是列数。

Answer 1

这个怎么样？

 Sub Sample() Dim finalArray() Dim R As Long For Each Index In someDictionary If Not someDictionary.Item(Index)(1) = 0 Then R = R + 1 Next Index ReDim finalArray(0 To R, 0 To 3) R = 0 For Each Index In someDictionary If Not someDictionary.Item(Index)(1) = 0 Then finalArray(R, 0) = someDictionary.Item(Index)(1) finalArray(R, 1) = someDictionary.Item(Index)(2) finalArray(R, 2) = someDictionary.Item(Index)(3) R = R + 1 End If Next Index End Sub 

Answer 2

你有几个select

1. 根据需要重新configuration数组，而不是创build前端（我认为这比在数组中循环两次更好:)）。 我已经添加这给你的评论tigeravatar
2. 转置数组以重新初始化维度
3. 根据tigeravatar忽略冗余数据

选项1

请注意，我已经翻阅了这些数据，以便在testingReDim时进行testing，而不是事先定义数组大小 – 它可能会说这改变了问题的性质，但我认为这个技术值得指出。 选项2显示如何转置arrays不pipe

 Sub SloaneDog() Dim finalArray() Dim R As Long Dim lngCnt As Long Dim lngCnt2 As Long lngCnt = 100 ReDim finalArray(1 To 3, 1 To lngCnt) somedictionary = Range("A1:C3001") For lngCnt2 = 1 To UBound(somedictionary, 1) finalArray(1, lngCnt2) = "data " & lngCnt2 If lngCnt2 Mod lngCnt = 0 Then ReDim Preserve finalArray(1 To 3, 1 To lngCnt2 + lngCnt) Next End Sub 

选项2

 Sub EddieBetts() Dim X() Dim Y() Dim LngCnt As Long ReDim X(1 To 1000, 1 To 3) Debug.Print UBound(X, 1) LngCnt = 100 Y = Application.Transpose(X) ReDim Preserve Y(1 To UBound(Y, 1), 1 To LngCnt) X = Application.Transpose(Y) Debug.Print UBound(X, 1) End Sub