|
易用宝能否增加按列内容分sheet的功能,我用vb编写宏可以实现,能否将此宏编写进易用宝,这样使用起来很方便。
Sub hjs()
Dim irow, irow1, i, j As Integer
Dim H As New Collection
Dim sht As Worksheet
Dim A
Dim ICol
Set A = ActiveCell
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For Each sht In Sheets
If sht.Name <> "总表" Then sht.Delete '删除所有分表
Next
Application.DisplayAlerts = True
ICol = Application.InputBox("请输入你所要分的列:(如按D列分请输入4)", "提示:", "4", Type:=1)
If ICol = "" Then Exit Sub
On Error Resume Next
With Sheets("总表")
irow = .[a1].CurrentRegion.Rows.Count
For i = 2 To irow
Cells(i, ICol) = "'" & Cells(i, ICol) '在原工作表生成文本符号
Next
For i = 2 To irow
H.Add .Cells(i, ICol), CStr(.Cells(i, ICol))
Next '建立一个不重复的筛选条件
For i = 1 To H.Count
.Cells.AutoFilter field:=ICol, Criteria1:=H(i)
Sheets.Add(after:=Sheets(Sheets.Count)).Name = H(i)
.[a1].CurrentRegion.Copy Sheets(CStr(H(i))).[a1] '自动筛选,并复制到新建的表中
irow1 = [a1].CurrentRegion.Rows.Count
For j = 2 To irow1
Cells(j, ICol) = Right(Cells(j, ICol), Len(Cells(j, ICol))) '消除新工作表文本符号
Next j
.Cells.AutoFilter
Debug.Print H(i)
Next i
A.Parent.Activate '激活汇总表的原来激活的单元格
A.Activate
For i = 2 To irow
.Cells(i, ICol) = Right(Cells(i, ICol), Len(Cells(i, ICol))) '消除原工作表文本符号
Next
End With
Application.ScreenUpdating = True
End Sub
|
|