一、在学习做一个按照输入的列数来拆分的通用代码。
二、结果在第三步,创建分表时IF判断是否有重复名时,提示应用程序定义或对象定义错误。
三、尝试把第三步单独拿出来运行,可以正常处理。代码如下:
Sub chaifenbiaodan()
'按照输入的列数拆分表单并复制数据
Dim i, j, k, l, m, n As Integer
Dim sht, sht1 As Worksheet
Dim rng1 As Range
Dim irow As Integer
'第一步,取得列数
l = InputBox("请输入您想要拆分的列数")
'第二步,清除多余工作表
Application.DisplayAlerts = False
If Sheets.Count > 1 Then
For Each sht1 In Sheets
If sht1.Name <> Sheets(1).Name Then
sht1.Delete
End If
Next
Application.DisplayAlerts = True
End If
'第三步,创建分表
irow = Sheets(1).Range("a65536").End(xlUp).Row
For i = 2 To irow
k = 0
For Each sht In Sheets
If sht.Name = Sheets(1).Cells(i, l).Value Then
k = 1
End If
Next
If k = 0 Then
Sheets.Add after:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = Sheet1.Cells(i, l)
End If
Next
'第四步,复制数值
For j = 2 To Sheets.Count
m = Sheets(1).Range("a1").End(xlDown).Row
n = Sheets(1).Range("a1").End(xlToRight).Column
Set rng1 = Sheets(1).Range("a1").Resize(m, n)
Sheets(1).rng1.AutoFilter Field:=l, Criteria1:=Sheets(j).Name
Sheets(1).rng1.Copy Sheets(j).Range("a1")
Next
End Sub
还请路过的大神帮忙看看
我实际测试了一下,但是不清楚你的Excel表内容是长什么样子的。但是本次你提出的问题帮你找到根源了:
If sht.Name = Sheets(1).Cells(i, l).Value Then
'该语句中Cells(i,l)我单看代码以为是壹没有想到是L,但是L是字符串变量,需要转换成整型变量,这里将代码修改为:
If sht.Name = Sheets(1).Cells(i, Val(l)).Value Then