麻烦优化VBA代码

zw0713

suntao2000 发表于 2023-3-3 17:49
```````````````````

找不到工程库，什么原因

suntao2000

zw0713 发表于 2023-3-3 18:07
找不到工程库，什么原因

只有字典没有其它的，没有其它的引用库.不存在这个问题的。

zw0713

suntao2000 发表于 2023-3-3 18:21
只有字典没有其它的，没有其它的引用库.不存在这个问题的。

单击领料1显示找不到工程或库

zw0713

zw0713 发表于 2023-3-3 18:25
单击领料1显示找不到工程或库

I列的订单号查找的，当I列订单号为空值时，就为空

suntao2000

zw0713 发表于 2023-3-3 18:25
单击领料1显示找不到工程或库

我这边运行的没问题，你可以查看代码，然后用F8一步一步试下哪句出错了

顺便把代码贴出来，看下其它朋友有没有人发现问题出在哪里？

Sub 领料1()
    Dim a, d1, d2, ar, br, i&, m$
    a = Sheets(32).UsedRange
    Set d1 = CreateObject("Scripting.Dictionary")
    Set d2 = CreateObject("Scripting.Dictionary")
    For i = 2 To UBound(a)
        If a(i, 2) <> "" And Not d1.Exists(a(i, 2)) Then
            d1(a(i, 2)) = a(i, 1) & "|" & a(i, 2) & "|" & a(i, 3) & "|" & a(i, 4) & "|" & a(i, 5)
            ReDim ar(1 To 5, 1 To 1)
            ar(1, 1) = a(i, 11): ar(2, 1) = a(i, 12): ar(4, 1) = a(i, 13): ar(5, 1) = a(i, 14)
            d2(a(i, 2)) = ar
   
        Else
            ar = d2(d1.keys()(d1.Count - 1))
            n = UBound(ar, 2)
            ReDim Preserve ar(1 To 5, 1 To n + 1)
            ar(1, n + 1) = a(i, 11): ar(2, n + 1) = a(i, 12): ar(4, n + 1) = a(i, 13): ar(5, n + 1) = a(i, 14)
            d2(d1.keys()(d1.Count - 1)) = ar
        End If
    Next
    With Sheets(33)
        For i = 0 To d1.Count - 1
            m = d1.keys()(i)
            br = Split(d1(m), "|")
            .Cells(i * 27 + 5, 7) = br(0)
            .Cells(i * 27 + 4, 9) = br(1)
            .Cells(i * 27 + 6, 2) = br(2)
            .Cells(i * 27 + 5, 2) = br(3)
            .Cells(i * 27 + 7, 4) = br(4)
            ar = d2(m)
            ReDim Preserve ar(1 To 5, 1 To 17)
            ar = Application.Transpose(ar)
            ReDim Preserve ar(1 To 17, 1 To 14)
            .Cells(i * 27 + 9, 1).Resize(UBound(ar), UBound(ar, 2)) = ar
        Next
    End With
End Sub