设为首页收藏本站Access中国

Office中国论坛/Access中国论坛

 找回密码
 注册

QQ登录

只需一步,快速开始

返回列表 发新帖
查看: 1525|回复: 2
打印 上一主题 下一主题

分表求助,要求保留原表单元格式

[复制链接]
跳转到指定楼层
1#
发表于 2009-3-20 10:46:14 | 只看该作者 回帖奖励 |倒序浏览 |阅读模式
其实我有一个思路是复制工作表后,删除不需要的行列,但是本人excel功力不够,恳请各位帮助。O(∩_∩)O谢谢

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有帐号?注册

x
分享到:  QQ好友和群QQ好友和群 QQ空间QQ空间 腾讯微博腾讯微博 腾讯朋友腾讯朋友
收藏收藏 分享分享 分享淘帖 订阅订阅

点击这里给我发消息

2#
发表于 2009-3-20 11:33:20 | 只看该作者
有个很久以前写的代码,比较弱,不过管用,参考一下。
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
3#
 楼主| 发表于 2009-3-23 08:50:22 | 只看该作者
有没有做好的
您需要登录后才可以回帖 登录 | 注册

本版积分规则

QQ|站长邮箱|小黑屋|手机版|Office中国/Access中国 ( 粤ICP备10043721号-1 )  

GMT+8, 2024-5-16 17:23 , Processed in 0.086691 second(s), 27 queries .

Powered by Discuz! X3.3

© 2001-2017 Comsenz Inc.

快速回复 返回顶部 返回列表