Question

我在将错误数组打印到范围时遇到了麻烦。我很确定我正在调整它的大小，但我不确定如何修复它。我创建了一个测试添加，它只添加了来自A列和B列的垃圾数据，但通常会从各个子/函数中调用AddPartError，然后在主脚本过程结束时，应将数组转储到工作表上。以下是相关功能：

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

Answer 1

确定。我做了一些检查，这不起作用的原因是因为你的PartErrors

的数组结构

PartErrors是一个一维数组，你正在为它添加数组，所以当你真正想要一个二维数组时，你最终会得到一个锯齿状数组（或数组数组）而不是多维数组

所以要解决这个问题，我认为你需要考虑将数组更改为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。您还需要移调阵列以适合您指定的范围。

Answer 2

您的代码有点难以理解，但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

将动态错误数组打印到工作表

2 个答案: