[已解决]菜鸟求一个VBA，将一列的各个单元格内容导出为txt文件

xyfu · 发表于 2013-3-7 10:49

求助的vba程序说明如下 1，某一列的各个单元格如A1, A2, A3, ......, 分别存放了不同的内容，我想把每一个单元格的内容导出为一个单独的txt文件，自动命名为1.txt, 2.txt, 3.txt, ......, 以此类推。
2，如果遇到某个单元格内容为空，则工作完成。
3，导出完成后，跳出对话框提示。

最佳答案

月排行榜 / 总排行榜

hwc2ycy

2013-3-7 11:04

Sub txt()
'---------------------------------------------------------------------------------------
' Procedure : txt
' Author : hwc2ycy
' Date : 2013/3/7
' Purpose :
'---------------------------------------------------------------------------------------
'
'数据行
Dim lRow As Long
'TXT文件编号
Dim lFile As Long
'文件号
Dim iFn As Byte
'保存位置
Dim sPath As String
'循环计数
Dim i As Long
'A列数组
Dim arr
'错误消息
Dim strError As String
sPath = ThisWorkbook.Path & Application.PathSeparator
lRow = Cells(Rows.Count, 1).End(xlUp).Row
arr = Range("a1:b" & lRow)
On Error Resume Next
For i = 1 To lRow
If Len(arr(i, 1)) > 0 Then
lFile = lFile + 1
'取文件号
iFn = FreeFile
'创建文件，每次内容均被覆盖,如果要追加就把OUTPUT改成APPEND
Open sPath & lFile & ".txt" For Output As #iFn
If Err.Number <> 0 Then
strError = strError & "A" & i & "写入TXT失败"
Err.Clear
Else
'写入A列对应行的数据
Print #iFn, arr(i, 1)
'关闭文件
Close #iFn
End If
End If
Next
'判断是否有写入失败的单元格
If Len(strError) > 0 Then
MsgBox strError
Else
MsgBox "输出完成"
End If
End Sub

复制代码

跳转到最佳答案楼层

hwc2ycy · 发表于 2013-3-7 10:57

Sub txt()
Dim lRow As Long
Dim lFile As Long
Dim iFn As Integer
Dim sPath As String
Dim i As Long
Dim arr
sPath = ThisWorkbook.Path & Application.PathSeparator
lRow = Cells(Rows.Count, 1).End(xlUp).Row
arr = Range("a1:b" & lRow)
For i = 1 To lRow
If Len(arr(i, 1)) > 0 Then
lFile = lFile + 1
iFn = FreeFile
Open sPath & lFile & ".txt" For Output As #iFn
Print #iFn, arr(i, 1)
Close #iFn
End If
Next
MsgBox "输出完成"
End Sub

复制代码

hwc2ycy · 发表于 2013-3-7 11:04

这个最佳答案由 hwc2ycy 给出，感谢 hwc2ycy 的回答。

单击隐藏图章

Sub txt()
'---------------------------------------------------------------------------------------
' Procedure : txt
' Author : hwc2ycy
' Date : 2013/3/7
' Purpose :
'---------------------------------------------------------------------------------------
'
'数据行
Dim lRow As Long
'TXT文件编号
Dim lFile As Long
'文件号
Dim iFn As Byte
'保存位置
Dim sPath As String
'循环计数
Dim i As Long
'A列数组
Dim arr
'错误消息
Dim strError As String
sPath = ThisWorkbook.Path & Application.PathSeparator
lRow = Cells(Rows.Count, 1).End(xlUp).Row
arr = Range("a1:b" & lRow)
On Error Resume Next
For i = 1 To lRow
If Len(arr(i, 1)) > 0 Then
lFile = lFile + 1
'取文件号
iFn = FreeFile
'创建文件，每次内容均被覆盖,如果要追加就把OUTPUT改成APPEND
Open sPath & lFile & ".txt" For Output As #iFn
If Err.Number <> 0 Then
strError = strError & "A" & i & "写入TXT失败"
Err.Clear
Else
'写入A列对应行的数据
Print #iFn, arr(i, 1)
'关闭文件
Close #iFn
End If
End If
Next
'判断是否有写入失败的单元格
If Len(strError) > 0 Then
MsgBox strError
Else
MsgBox "输出完成"
End If
End Sub

复制代码

hwc2ycy · 发表于 2013-3-7 11:09

A列写入TXT.rar (17.11 KB, 下载次数: 307)

xyfu · 发表于 2013-3-7 11:26

很好用。谢谢hwc2ycy.

匿名 *发表于 2014-10-10 12:40* · 发表于 2014-10-10 12:40

hwc2ycy 发表于 2013-3-7 11:09

感谢你的帮助，挺好用的，呵呵

匿名 *发表于 2014-11-14 10:08* · 发表于 2014-11-14 10:08

hwc2ycy 发表于 2013-3-7 11:09

表格非常好用。多谢高手分享

		自动登录	找回密码
密码			注册

[已解决]菜鸟求一个VBA，将一列的各个单元格内容导出为txt文件

点评