数组赋值的问题

wanfang002

请问为什么把一个数组arr1的数值赋给另一个数组arr4的数值时，另一数组arr4会出现，当其定义为arr4() as variant时，显示空值; 定义为arr4 as variant时，显示为<类型不匹配>。

yaohwang

发详细点的代码吧

wanfang002

yaohwang 发表于 2014-1-8 11:45
发详细点的代码吧

第一次自主编VBA，后面几行还没想好的还有很多错误，目前主要就是那个
arr4(k, Counter4) = arr1(Item1, k):
无论如何都不行，之前编过一个类似的循环都是可以的。这次只不过多了些数组还有用了个字典。

Option Base 1
Sub 报表生成()
    Dim arr1() As Variant, arr2() As Variant, Item1 As Long, Item2 As Long, MaxRow1 As Long, MaxColumn1 As Long
    Dim arr4() As Variant, Counter4 As Long, Item4 As Long, i As Long, j As Long, k As Integer
    Dim Counter5 As Long, Item5 As Long, arr5() As Variant, arr6() As Variant
    Dim arr3 As Variant, Item3 As Long, MaxRow3 As Long
    With CreateObject("scripting.dictionary")
         Dim Dic1 As Object, DItem1 As Long
         i = 2: j = 2
         On Error Resume Next
         For DItem1 = 1 To Sheet3.Cells(Rows.Count, 1).End(xlUp).Row
             .Add Sheet3.Cells(DItem1, 1).Value, ""
         Next DItem1
         Sheet2.[A1].Resize(.Count, 1) = WorksheetFunction.Transpose(.keys)
    End With
    MaxRow1 = Sheet3.Cells(Rows.Count, "A").End(xlUp).Row
    arr1 = Sheet3.Range("A2:D" & MaxRow1)
    MaxColumn1 = Sheet2.Range("XFD1").End(xlToLeft).Column
    arr2 = Sheet2.Range(Cells(1, 2), Cells(1, MaxColumn1))
    arr6 = WorksheetFunction.Transpose(arr2)
    MaxRow3 = Sheet2.Cells(Rows.Count, "A").End(xlUp).Row
    arr3 = Sheet2.Range("A2:A" & MaxRow3).Value
    'MsgBox UBound(arr6)
    Sheet2.Cells(2, 2) = arr2(1, 3)
    For Item3 = 1 To UBound(arr3)
        For Item1 = 1 To UBound(arr1)
            If arr1(Item1, 1) = arr3(Item3, 1) Then Counter4 = Counter4 + 1: ReDim Preserve arr4(1 To 4, 1 To Counter4): For k = 1 To 4: arr4(k, Counter4) = arr1(Item1, k): Next k
        Next Item1
        For Item2 = 1 To UBound(arr2)
            For Item4 = 1 To UBound(arr4)
                If arr4(Item4) = arr2(Item2) Then Counter5 = Counter5 + 1: ReDim Preserve arr5(1, 1 To Counter5): arr5(1, Counter5) = arr4(Item4, 1)
            Next Item4
            Sheet2.Cells(i, j) = UBound(arr4)
            j = j + 1
        Next Item2
        i = i + 1
        j = 2
    Next Item3
End Sub

wanfang002

刚试了下把红色部分arr4换成arr2进行赋值是没有问题的， 好奇怪

wanfang002

问题已解决，按F8运行发现用光标放到值上有问题，其实看本地窗口本来就是OK的。