[已解决]如何批量保存EXCEL表中单元格内容为txt文件?

abn223

如何批量保存EXCEL表中单元格内容为txt文件?

比如EXCEL表中A列是物品名称，B列是物品的具体内容，现在想批量保存B单元格内容大于0、以A单元格内容为文件名、B单元格内容为文件内容、格式为txt文本的txt文件。

如下表，可以保存为8个txt文件，电视机.txt、电冰箱.txt、空调.txt、洗衣机.txt、自行车.txt、摄像机.txt、播放器.txt、影碟机.txt。电饭锅、照相机因为B列没有内容（B单元格为0）所以不保存。

（实际EXCEL表的内容有200多行，下表只是简单的例举）

却不知如何下手,如何实现？请帮助,谢谢!

	A	B	C
1	电视机	10000台
2	电冰箱	10001台
3	电饭锅	0
4	空调	10003台
5	洗衣机	10004台
6	自行车	10005台
7	照相机	0
8	摄像机	10007台
9	播放器	10008台
10	影碟机	10009台

最佳答案

月排行榜 / 总排行榜

wp8680

2016-3-8 12:26

1. Sub savetext()
   
2.     Dim arr, istr As String, ipath As String
   
3.     Dim n%
   
4.     arr = Range("a1:b10").Value
   
5.     For n = 1 To UBound(arr, 1)
   
6.         If arr(n, 2) > 0 Then
   
7.             ipath = ThisWorkbook.Path & "" & arr(n, 1) & ".txt"
   
8.             istr = arr(n, 2)
   
9.             Open ipath For Output As #1
   
10.             Print #1, istr
    
11.             Close #1
    
12.         End If
    
13.     Next n
    
14. End Sub

复制代码

没有验证，自己运行下看看有没有错。

跳转到最佳答案楼层

wp8680

1. Sub savetext()
   
2.     Dim arr, istr As String, ipath As String
   
3.     Dim n%
   
4.     arr = Range("a1:b10").Value
   
5.     For n = 1 To UBound(arr, 1)
   
6.         If arr(n, 2) > 0 Then
   
7.             ipath = ThisWorkbook.Path & "" & arr(n, 1) & ".txt"
   
8.             istr = arr(n, 2)
   
9.             Open ipath For Output As #1
   
10.             Print #1, istr
    
11.             Close #1
    
12.         End If
    
13.     Next n
    
14. End Sub

复制代码

没有验证，自己运行下看看有没有错。

abn223

wp8680 发表于 2016-3-8 12:26
没有验证，自己运行下看看有没有错。

你好，谢谢你帮助，试下看看，谢谢！

abn223

有没有更好的？请各位帮助，谢谢！

爱疯

Sub test()
    Dim A, p, i
    A = Range("a1").CurrentRegion
    p = ThisWorkbook.path & "\"
    For i = 1 To UBound(A)
        If A(i, 2) <> 0 Then Call writeTxt4(p, A(i, 1) & ".txt", A(i, 2))
    Next i
End Sub


Sub writeTxt4(p, f, str)
    With CreateObject("Scripting.FileSystemObject").CreateTextFile(p & f, True, -1)
        .Write str
        .Close
    End With
End Sub

abn223

wp8680 发表于 2016-3-8 12:26
没有验证，自己运行下看看有没有错。

你好，谢谢你的帮助，要的就是这，谢谢！

abn223

爱疯 发表于 2016-3-11 11:31
Sub test()
    Dim A, p, i
    A = Range("a1").CurrentRegion

你好，谢谢你的帮助，谢谢！