错误：下标越界

zhongtaizu43

如下图所示，想把“总表”的J列“票据类型”拆分出多个附表，写了代码后出错 显示“下标越界”，应该如何修改？

sj15627581616

表名错误，不存在的工作表

3190496160

Sub 拆分工作表()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim d As Object
Dim ar As Variant
Set d = CreateObject("scripting.dictionary")
For Each sh In Sheets
    If sh.Index > 11 Then
        sh.Delete
    End If
Next sh
Application.DisplayAlerts = True
With Sheets("总表")
    r = .Cells(Rows.Count, 10).End(xlUp).Row
    ar = .Range("j1:j" & r)
    For i = 2 To UBound(ar)
        If Trim(ar(i, 1)) <> Empty Then
            If Not d.exists(Trim(ar(i, 1))) Then
                Set d(Trim(ar(i, 1))) = .Rows(i)
            Else
                Set d(Trim(ar(i, 1))) = Union(d(Trim(ar(i, 1))), .Rows(i))
            End If
        End If
    Next i
End With
x = d.keys
For i = 0 To UBound(x)
    Sheets("总表").Copy after:=Sheets(Sheets.Count)
    With ActiveSheet
        .name = x(i)
        .UsedRange.Offset(1).Borders.LineStyle = 0
        .UsedRange.Offset(1) = Empty
        d.items()(i).Copy .[a2]
    End With
Next i
Set d = Nothing
Application.ScreenUpdating = False
MsgBox "ok!"
End Sub

3190496160

VBA-每日训练2.rar (50.56 KB, 下载次数: 2)

2024-1-27 08:27 上传

点击文件名下载附件

3190496160

基础不牢，地动山摇，
更何况，楼主还在连最基本的东西都还没弄明白的，

zhongtaizu43

3190496160 发表于 2024-1-27 08:26
Sub 拆分工作表()
Application.ScreenUpdating = False
Application.DisplayAlerts = False

谢谢你，辛苦

zhongtaizu43

3190496160 发表于 2024-1-27 08:28
基础不牢，地动山摇，
更何况，楼主还在连最基本的东西都还没弄明白的，

如果我基础牢固什么都懂的话，就不会在论坛上问了，我也在努力学啊，但不是每个人都有那么多时间去做的

zhongtaizu43

sj15627581616 发表于 2024-1-27 08:24
表名错误，不存在的工作表

好奇怪，我已经修改过附表的名称了，改为“总表”，后来一执行代码，还是不行。

半百

从第11个表开始判断“类型”存不存在，如果不存在就新增一个，应该循环到最后判断完才能确定存不存在，你遇到第一个表不符时就新增，能不出错吗？

3190496160

zhongtaizu43 发表于 2024-1-27 09:50
如果我基础牢固什么都懂的话，就不会在论坛上问了，我也在努力学啊，但不是每个人都有那么多时间去做的

呵呵呵呵呵呵呵呵呵呵呵呵
别人的好心相劝当成了驴肝肺了，后悔早上写了这段代码