[已解决]导出数据，先谢了

vikyu

一定要弹出窗口，选择保存文件的位置。


导出.zip (24.23 KB, 下载次数: 16)

2016-1-5 23:05 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

心正意诚身修

2016-1-6 13:21

测试了一下,没有name错误啊,原文件也没有删掉f:g,直接点按钮,不要F8.可能活动窗口让你点变了吧.不行的话,再测试下下面的代码.复制粘贴为数值了

1. Sub xx()
   
2. fn = Application.GetSaveAsFilename("结果", "Excel Files (*.xlsx), *.xlsx")
   
3. Range("a10").CurrentRegion.SpecialCells(xlCellTypeVisible).Copy
   
4. Set nwk = Workbooks.Add: Sheets("sheet1").Select
   
5. [a1].PasteSpecial Paste:=xlPasteValues: [f:g].Delete
   
6. If fn <> "" Then
   
7.    ActiveWorkbook.SaveAs fn
   
8.    ActiveWorkbook.Close
   
9. End If
   
10. MsgBox "已保存成功"
    
11. End Sub

复制代码

跳转到最佳答案楼层

心正意诚身修

1.   Sub xx()
   
2. fn = Application.GetSaveAsFilename("结果", "Excel Files (*.xlsx), *.xlsx")
   
3. Range("a10").CurrentRegion.SpecialCells(xlCellTypeVisible).Copy
   
4. Set nwk = Workbooks.Add: Sheets("sheet1").Select: ActiveSheet.Paste
   
5. If fn <> "" Then
   
6.    ActiveWorkbook.SaveAs fn
   
7.    ActiveWorkbook.Close
   
8. End If
   
9. MsgBox "已保存成功"
   
10. End Sub

复制代码

vikyu

心正意诚身修 发表于 2016-1-6 07:31

能实现功能 不过F列首重、G列续重 能否帮忙删除掉呢？

心正意诚身修

加一句

Sub xx()
fn = Application.GetSaveAsFilename("结果", "Excel Files (*.xlsx), *.xlsx")
Range("a10").CurrentRegion.SpecialCells(xlCellTypeVisible).Copy
Set nwk = Workbooks.Add: Sheets("sheet1").Select: ActiveSheet.Paste: [f:g].Delete
If fn <> "" Then
   ActiveWorkbook.SaveAs fn
   ActiveWorkbook.Close
End If
MsgBox "已保存成功"
End Sub

vikyu

不好意思 刚才没注意看。
二楼那个代码 导出结果有误，由于H列金额是含有自定义公式函数，导出结果金额会出现：#NAME?。
四楼那个代码 删除F、G列 源文件也会删除，金额也不对。
不好意思 只能再麻烦高手了。

心正意诚身修

测试了一下,没有name错误啊,原文件也没有删掉f:g,直接点按钮,不要F8.可能活动窗口让你点变了吧.不行的话,再测试下下面的代码.复制粘贴为数值了

1. Sub xx()
   
2. fn = Application.GetSaveAsFilename("结果", "Excel Files (*.xlsx), *.xlsx")
   
3. Range("a10").CurrentRegion.SpecialCells(xlCellTypeVisible).Copy
   
4. Set nwk = Workbooks.Add: Sheets("sheet1").Select
   
5. [a1].PasteSpecial Paste:=xlPasteValues: [f:g].Delete
   
6. If fn <> "" Then
   
7.    ActiveWorkbook.SaveAs fn
   
8.    ActiveWorkbook.Close
   
9. End If
   
10. MsgBox "已保存成功"
    
11. End Sub

复制代码

vikyu

心正意诚身修 发表于 2016-1-6 13:21
测试了一下,没有name错误啊,原文件也没有删掉f:g,直接点按钮,不要F8.可能活动窗口让你点变了吧.不行的话,再 ...

可以实现 但为Private Sub CommandButton2_Click()代码 不正常。
麻烦老师按新文件帮我修改一下。一定要使用Private代码。
一定要实现筛选也能正常导出。万分感谢。
整体.zip (28.39 KB, 下载次数: 11)

2016-1-6 21:10 上传

点击文件名下载附件

vikyu

在线等 高手帮忙一下解决7楼 这是我流程中最后一步 万分感谢。

vikyu

老是麻烦老师真不好意思 不过这个真的麻烦坛内各高手 万分感谢

vikyu

此代码用宏代码运行结果对的 可用Private Sub运行结果不对 能否帮忙修改一下 万分感谢。.