返回信息流图片描述
1、表1
2、由表1 自动生成表2，过滤掉其中的空白单元格
备注：要自动生成的，不要筛选复制粘贴的，数据量比较大，
据说通过函数可以实现？求助牛人出现，谢谢！
这是一条镜像帖。来源：北邮人论坛 / office-tool / #28057同步于 2010/5/6
该镜像源已超过 30 天没有更新，可能在源站已被删除。
OfficeTool机器人发帖
求助：自动根据原表生成excel，且过滤掉原来的空白单元格
weiluolanlin
2010/5/6镜像同步7 回复
订阅后，新回复会通过你的通知中心匿名送达。
7 条回复
筛选复制粘贴录成宏
【 在 weiluolanlin (〖爱乐魂〗夕颜花开) 的大作中提到: 】
: 图片描述
: 1、表1
: [upload=1][/upload]
: ...................
随便一写。。。
Sub Test()
Dim Num As Integer
Columns("A:C").Select
Selection.AutoFilter Field:=2, Criteria1:="="
Num = Cells.SpecialCells(xlCellTypeLastCell).Row
Rows(2 & ":" & Num).Select
Selection.Delete Shift:=xlUp
Selection.AutoFilter
Range("A1").Select
End Sub
【 在 flycat (曾经的小十九|狂拍组.怀念家里的酸菜) 的大作中提到: 】
: 筛选复制粘贴录成宏
筛选删除在数据量大的时候有出错的可能，建议用循环删除
函数可以实现，但是数据量大的话，效率过低
解决方法参见附件。
附件(32KB) Book1.xls
【 在 xiongQQ 的大作中提到: 】
: 随便一写。。。
: Sub Test()
: Dim Num As Integer
: ...................
试试我写的这个好不好用？？嘻嘻
程序见附件
Sub D16以列为空则删除整行()
F = Application.GetOpenFilename("Excel参数表(*.xls), *.xls,Excel文件(*.xla), *.xla,所有文件(*.*), *.*", , " 请单选目的文件 ")
If F = False Then Exit Sub
Dim tempwb As Workbook
Set tempwb = Workbooks.Open(F)
Dim dInput As Integer
dInput = Application.InputBox(Prompt:=" 若某列中某一个单元格为空格,则删除所在行.请输入要需要进行判定的列数,如1,2,3 ", Type:=1)
If dInput = False Then
tempwb.Close savechanges:=False
Exit Sub
End If
For i = ActiveSheet.UsedRange.Rows.Count To 1 Step -1
If Cells(i, dInput) = "" Then
Rows(i & ":" & i).Select
Selection.Delete Shift:=xlUp
End If
Next i
Set tempwb = Nothing
Set F = Nothing
MsgBox " 删除完毕~ "
End Sub