求教如何处理错误溢出

qq496805224

求教大神查看，给出解决方案

roych

这个写法好像有点问题。end的后面。。。。我忙完再看看。

qq496805224

roych 发表于 2016-12-15 10:40
这个写法好像有点问题。end的后面。。。。我忙完再看看。

多谢大神，我也属于小白，有错麻烦等大神有空，帮我更改一下

Benjamin_luk

附件没有VBA
Range使用最好指定SHEET
如此sheet1.range()
end用法如下：
.End(xlUp)
实在不行，可以用录制宏的方法查看如何写代码

qq496805224

忘了加上vba，抱歉！
Sub NewSht()
    Dim Dic As Object
    Dim Arr, Ary, k%, i%, icol%

    Set Dic = CreateObject("Scripting.Dictionary")
    Arr = Range("A1", [A2000].End(3)(1, 22))
    For k = 9 To UBound(Arr)
        Dic(Arr(k, 9)) = ""
    Next

    For Each Key In Dic.keys
        If Key <> "" Then
            ReDim Ary(0 To UBound(Arr), 1 To 22)
            i = -1
            For k = 1 To UBound(Arr)
                If Arr(k, 9) = Key Or k = 1 Then
                    i = i + 1
                    For icol = 1 To 22
                        Ary(i, icol) = Arr(k, icol)
                    Next
                End If
            Next


            Workbooks.Add
            With ActiveWorkbook
                .ActiveSheet.[A1].Resize(i + 1, 22) = Ary
                .ActiveSheet.[A1].Resize(i + 1, 22).Borders.LineStyle = 1
                .SaveAs ThisWorkbook.Path & "\" & Split(Key, " ")(0) & ".xlsx"
                .Close
            End With
        End If
    Next
    Dic.RemoveAll
End Sub