Office中国论坛/Access中国论坛

标题: 求教如何处理错误溢出 [打印本页]

作者: qq496805224 时间: 2016-12-15 10:31
标题: 求教如何处理错误溢出
求教大神查看，给出解决方案

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

作者: qq496805224 时间: 2016-12-15 10:47

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

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

作者: Benjamin_luk 时间: 2016-12-15 13:17
附件没有VBA
Range使用最好指定SHEET
如此sheet1.range()
end用法如下：
.End(xlUp)
实在不行，可以用录制宏的方法查看如何写代码

作者: qq496805224 时间: 2016-12-15 13:39
忘了加上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

欢迎光临 Office中国论坛/Access中国论坛 (http://www.office-cn.net/)