将dynamic错误数组打印到工作表

我有麻烦让我的错误数组打印到一个范围。 我很确定我正在调整它的大小,但我不知道如何解决它。 我创build了一个testing添加,它只是添加了列A和B的垃圾数据,但通常AddPartError会从各个子/函数中调用,然后在主脚本过程结束时将数组转储到工作表上。 这里是相关的function:

Sub testadd() For Each i In ActiveSheet.Range("A1:A10") Call AddPartError(i.value, i.Offset(0, 1)) Next i tmp = PartErrors PrintArray PartErrors, ActiveWorkbook.Worksheets("Sheet1").[D1] Erase PartErrors tmp1 = PartErrors PartErrorsDefined = 0 End Sub Sub PrintArray(Data As Variant, Cl As Range) Cl.Resize(UBound(Data, 1), 2) = Data End Sub Private Sub AddPartError(part As String, errType As String) If Not PartErrorsDefined = 1 Then ReDim PartErrors(1 To 1) As Variant PartErrorsDefined = 1 End If PartErrors(UBound(PartErrors)) = Array(part, errType) ReDim Preserve PartErrors(1 To UBound(PartErrors) + 1) As Variant End Sub 

好。 我做了一些检查,这是行不通的原因是你的PartErrors数组结构

PartErrors是一个1维数组,并且你正在向它添加数组,所以当你实际上需要一个二维数组的时候,你最终会得到一个锯齿的数组(或数组数组)

所以要解决这个问题,我认为你需要考虑将你的数组改为2d。 像下面的东西

 Private Sub AddPartError(part As String, errType As String) If Not PartErrorsDefined = 1 Then ReDim PartErrors(1 To 2, 1 To 1) As Variant PartErrorsDefined = 1 End If PartErrors(1, UBound(PartErrors, 2)) = part 'Array(part, errType) PartErrors(2, UBound(PartErrors, 2)) = errType ReDim Preserve PartErrors(1 To 2, 1 To UBound(PartErrors, 2) + 1) As Variant End Sub 

 Sub PrintArray(Data As Variant, Cl As Range) Cl.Resize(UBound(Data, 2), 2) = Application.Transpose(Data) End Sub 

NB。 您还需要调整您的数组以适应您指定的范围。

你的代码有点难以遵循,但是redim清除了数组中的数据,所以我认为你需要使用“Preserve”关键字。

下面是一些示例代码,您可以通过它们了解它是如何工作的,但是您需要花一些时间来研究如何将其应用到代码中。

祝你好运!

 Sub asda() 'declare an array Dim MyArray() As String 'First time we size the array I do not need the "Preserve keyword 'there is not data in the array to start with!!! 'Here we size it too 2 by 5 ReDim MyArray(1, 4) 'Fill Array with Stuff For i = 0 To 4 MyArray(0, i) = "Item at 0," & i MyArray(1, i) = "Item at 1," & i Next ' "Print" data to worksheet Dim Destination1 As Range Set Destination1 = Range("a1") Destination1.Resize(UBound(MyArray, 1) + 1, UBound(MyArray, 2) + 1).Value = MyArray 'Now lets resize that arrray 'YOU CAN ONLY RESIZE THE LAST SIZE OF THE ARRAY - in this case 4 to 6... ReDim Preserve MyArray(1, 6) For i = 5 To 6 MyArray(0, i) = "New Item at 0," & i MyArray(1, i) = "New Item at 1," & i Next 'and let put that next to our first list ' "Print" data to worksheet Dim Destination2 As Range Set Destination2 = Range("A4") Destination2.Resize(UBound(MyArray, 1) + 1, UBound(MyArray, 2) + 1).Value = MyArray End Sub