|
楼主 |
发表于 2015-12-9 14:49
|
显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用 · 内置多项VBA编程加强工具 ★ 免费下载 ★ ★ 使用手册★
Sub cfs()
Dim GSArr() As String '公司名称清单
Dim Rca As Integer 'A列数据行数
Dim i As Integer
Dim Sn As String
Sn = ActiveSheet.Name
Rca = Columns("A:A").End(xlDown).Row
ReDim GSArr(1 To 1)
GSArr(1) = Cells(2, 1)
For i = 3 To Rca
If IsError(Application.Match(Cells(i, 1), GSArr, 0)) Then
ReDim Preserve GSArr(1 To UBound(GSArr) + 1)
GSArr(UBound(GSArr)) = Cells(i, 1)
End If
Next
If ActiveSheet.AutoFilterMode = False Then
Rows("1:1").AutoFilter
Else
If ActiveSheet.FilterMode = True Then ActiveSheet.ShowAllData
End If
For i = 1 To UBound(GSArr)
ActiveSheet.Cells.AutoFilter Field:=1, Criteria1:=GSArr(i)
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = GSArr(i)
Sheets(Sn).Cells.Copy ActiveSheet.Cells
Sheets(Sn).Activate
Next
ActiveSheet.Cells.AutoFilter
End Sub
运行上述代码提示资源不足。。。 |
|