拆分工作表后如何自动生成序号

铁马1980

拆分工作表后形成的新工作表,第一列的序号是来自"源数据"表的.


我想让拆分后的新数据表序号从重新排列:1,2,3……
我在网上也找了段代码，但好像因为有两个统计报表，代码运行后显示下标越界，

恳请大神帮我看下问题出在哪里，刚接触VBA, 好多问题还不懂，谢谢了。

示例.zip (23.67 KB, 下载次数: 20)

2019-3-26 18:23 上传

点击文件名下载附件

taller

是需要实现分拆，还是需要实现自动编号？

铁马1980

taller 发表于 2019-3-26 18:33
是需要实现分拆，还是需要实现自动编号？

自动编号就可以了

jiminyanyan

铁马1980 发表于 2019-3-26 18:34
自动编号就可以了

Sub num()
    For Each sh In Sheets
        If sh.Name <> "源数据" And _
           sh.Name <> "统计表一" And _
           sh.Name <> "统计表二" Then
            With sh
                r = .[a65536].End(xlUp).Row
                r = r - 1
                ReDim arr(1 To r, 1 To 1)
                For x = 1 To r
                    arr(x, 1) = x
                Next
                .[a2].Resize(r, 1) = arr
            End With
        End If
        r = 0
        Erase arr
    Next
    MsgBox "ok"
End Sub

jiminyanyan

铁马1980 发表于 2019-3-26 18:34
自动编号就可以了

OR用错了。。。。。。。。

铁马1980

jiminyanyan 发表于 2019-3-26 18:46
Sub num()
    For Each sh In Sheets
        If sh.Name  "源数据" And _

谢谢,不过这个和我附件里带的一样的问题,都是显示 "下标越界"

网海遨游

1. Sub num()
   
2.     For Each sh In Sheets
   
3.         If sh.Name <> "源数据" And sh.Name <> "统计表一" And sh.Name <> "统计表二" Then
   
4.            With sh
   
5.                 r = .[b65536].End(xlUp).Row - 1
   
6.                 sh.Range("a2:a" & r + 1).ClearContents
   
7.                 ReDim arr(1 To r, 1 To 1)
   
8.                 For x = 1 To r
   
9.                     arr(x, 1) = x
   
10.                 Next
    
11.                 .[a2].Resize(r, 1) = arr
    
12.             End With
    
13.         End If
    
14.         r = 0
    
15.         Erase arr
    
16.     Next
    
17.     MsgBox "ok"
    
18. End Sub

复制代码

jiminyanyan

铁马1980 发表于 2019-3-26 20:17
谢谢,不过这个和我附件里带的一样的问题,都是显示 "下标越界"

你没用我的代码把，我给你的是AND。。。

铁马1980

jiminyanyan 发表于 2019-3-26 18:46
OR用错了。。。。。。。。

明白了,谢谢.

铁马1980

网海遨游 发表于 2019-3-26 20:32

一并感谢^^