Office中国论坛/Access中国论坛

标题: 分表求助，要求保留原表单元格式 [打印本页]

作者: IOIP009 时间: 2009-3-20 10:46
标题: 分表求助，要求保留原表单元格式
其实我有一个思路是复制工作表后，删除不需要的行列，但是本人excel功力不够，恳请各位帮助。O(∩_∩)O谢谢

作者: pureshadow 时间: 2009-3-20 11:33
有个很久以前写的代码，比较弱，不过管用，参考一下。
Sub div()
Dim myrow As Long
Dim mycol As Long
Dim i As Long
myrow = [a65536].End(xlUp).Row
mycol = [iv1].End(xlToLeft).Column
Range("A1:A" & myrow).AdvancedFilter Action:=xlFilterInPlace, Unique:=True
Range("A2:A" & myrow).SpecialCells(xlCellTypeVisible).Copy Destination:=Cells(1, mycol + 1)
ActiveSheet.ShowAllData
Range(Cells(1, 1), Cells(1, mycol)).AutoFilter
For i = 1 To Application.CountA(Columns(mycol + 1))
Sheets.Add
ActiveSheet.Name = Cells(i, mycol + 1)
Range(Cells(1, 1), Cells(1, mycol)).AutoFilter Field:=1, Criteria1:=Cells(i, mycol + 1)
Range(Cells(1, 1), Cells(myrow, mycol)).SpecialCells(xlCellTypeVisible).Copy Destination:=ActiveSheet.Range("a1")
Next
Sheets("sheet1").Select
Range(Cells(1, 1), Cells(1, mycol)).AutoFilter
Columns(mycol + 1).ClearContents
End Sub

作者: IOIP009 时间: 2009-3-23 08:50
有没有做好的
？

欢迎光临 Office中国论坛/Access中国论坛 (http://www.office-cn.net/)