ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 效率神器,一键搞定繁琐工作
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
让更多数据处理,一键完成 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
查看: 1067|回复: 0

求助:请大侠对此VBA进行修改。

[复制链接]

TA的精华主题

TA的得分主题

发表于 2014-7-13 23:05 | 显示全部楼层 |阅读模式
Sub 导出数据文件()
Dim DestFile As String
Dim FileNum As Integer
Dim ColumnCount As Integer
Dim RowCount As Integer
Dim today As Date

today = Now()
fileNames = Split(ThisWorkbook.Name, ".")
DestFile = ThisWorkbook.Path + "\" + "icbc_" + ActiveSheet.Cells(2, 2).Text + ".txt"
' 提示用户指定目标文件名。
'DestFile = InputBox("请输入导出的数据文件名" & _
'Chr(10) & "(包括所有完整路径和文件的扩展名):", _
'"Quote-Comma Exporter")
' 获取下一个可用的文件句柄编号。
FileNum = FreeFile()

' 关闭错误检查功能。
On Error Resume Next

' 尝试打开目标文件以供输出。
Open DestFile For Output As #FileNum
' 如果出现错误,则报告错误并结束程序。
If Err <> 0 Then
MsgBox "不能打开目标文件 " & DestFile
End
End If
Columns("E:E").NumberFormatLocal = "@"
' 打开错误检查功能。
On Error GoTo 0

' 循环选择的每一行。

For RowCount = 4 To ActiveSheet.UsedRange.Rows.Count - 1
' 循环选择的每一列。
Print #FileNum, "";
For ColumnCount = 1 To ActiveSheet.UsedRange.Columns.Count
If Len(ActiveSheet.Cells(RowCount, "A").Text) <= 0 Then GoTo AA1

If Len(ActiveSheet.Cells(RowCount, "E").Text) <= 0 Then GoTo AA1

If Len(ActiveSheet.Cells(RowCount, ColumnCount).Text) > 0 Then
' 将当前单元格中的文本写入到文件中,文本用引号括起来。
Print #FileNum, ActiveSheet.Cells(RowCount, ColumnCount).Text;
' 检查单元格是否位于最后一列。
Else
Print #FileNum, "";
End If
If ColumnCount = ActiveSheet.UsedRange.Columns.Count Then
' 如果是,则写入一个空行(null)。
Print #FileNum, ""
Else
' 否则,则写入一个|。
Print #FileNum, "|";
End If
' 开始 ColumnCount 循环的下一个迭代。
AA1:
Next ColumnCount
' 开始 RowCount 循环的下一个迭代。
Next RowCount

' 关闭目标文件。
Close #FileNum
MsgBox "数据已经导出到[" + DestFile + "]文件中"
End Sub



增加内容:
1、增加每100条数据存一个txt文件,文件名根据文件递增。比如icbc_1321054_001.txt、icbc_1321054_002.txt
2、每个txt首行是行4的内容。并且C4随该个txt行数变化而变化
3、现VBA生成的txt最后一行是空格,修改后能否没有最后一行空格。

转换工具.rar

16.68 KB, 下载次数: 2

您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2024-11-23 04:17 , Processed in 0.031674 second(s), 11 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

沪公网安备 31011702000001号 沪ICP备11019229号-2

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:李志群律师

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