[已解决]新手求助将execl的sheet1中的列A,C,E导出，并生成txt文件

zhxqer

将execl的sheet1中的列A,C,E导出，并生成txt文件
每个单元格数据间“，”隔开
每行最后一个数据“；”结束

如
表中数据
A  C  E
1  3  4
2  5  7
4  9  6

则
txt数据
1,3,4；
2,5,7；
4,9,6；

最佳答案

月排行榜 / 总排行榜

hwc2ycy

2013-6-25 19:20

1. Sub ACEToTXT()
   
2.     Dim arr
   
3.     Dim fileNO
   
4.     Dim strFile$
   
5.     Dim i As Long
   
6.     On Error GoTo ErrorHandler:
   
7. 
   
8.     strFile = ThisWorkbook.Path & Application.PathSeparator & Format(Now, "yyyymmddhhmm") & ".txt"
   
9.     fileNO = FreeFile
   
10.     Open strFile For Output Access Write As #fileNO
    
11.     arr = ActiveSheet.UsedRange.Columns("a:e").Value
    
12.     For i = 1 To UBound(arr)
    
13.         Print #fileNO, IIf(IsNumeric(arr(i, 1)), Format(arr(i, 1), "000000"), arr(i, 1)) & "," & IIf(IsNumeric(arr(i, 3)), Format(arr(i, 3), "000000"), arr(i, 3)) & "," & IIf(IsNumeric(arr(i, 5)), Format(arr(i, 5), "000000"), arr(i, 5))
    
14.     Next
    
15.     Close #fileNO
    
16.     MsgBox "文件导出到 " & strFile
    
17.     Exit Sub
    
18.    
    
19. ErrorHandler:
    
20.     MsgBox Err.Number & vbCrLf & _
    
21.            Err.Description
    
22.     Err.Clear
    
23.     Close #fileNO
    
24. End Sub
    

复制代码

跳转到最佳答案楼层

hwc2ycy

趁下班前，练下，

hwc2ycy

1. Sub ACEToTXT()
   
2.     Dim arr
   
3.     Dim fileNO
   
4.     Dim strFile$
   
5.     Dim i As Long
   
6.     strFile = ThisWorkbook.Path & Application.PathSeparator & Format(Now, "yyyymmddhhmm") & ".txt"
   
7.     fileNO = FreeFile
   
8.     Open strFile For Output Access Write As #fileNO
   
9.     arr = Range("a1").CurrentRegion
   
10.     For i = 1 To UBound(arr)
    
11.         Print #fileNO, arr(i, 1) & "," & arr(i, 3) & "," & arr(i, 5)
    
12.     Next
    
13.     Close #fileNO
    
14.     MsgBox "ok"
    
15. End Sub

复制代码

hwc2ycy

1. Sub ACEToTXT()
   
2.     Dim arr
   
3.     Dim fileNO
   
4.     Dim strFile$
   
5.     Dim i As Long
   
6.     strFile = ThisWorkbook.Path & Application.PathSeparator & Format(Now, "yyyymmddhhmm") & ".txt"
   
7.     fileNO = FreeFile
   
8.     Open strFile For Output Access Write As #fileNO
   
9.    
   
10.     arr = Range("a1").CurrentRegion
    
11.     For i = 1 To UBound(arr)
    
12.         'Print #fileNO, arr(i, 1) & "," & arr(i, 3) & "," & arr(i, 5)
    
13.         Write #fileNO, arr(i, 1), arr(i, 3), arr(i, 5)
    
14.     Next
    
15.     Close #fileNO
    
16.     MsgBox "文件导出到 " & strFile
    
17. End Sub
    

复制代码

hwc2ycy

1. Sub ACEToTXT()
   
2.     Dim arr
   
3.     Dim fileNO
   
4.     Dim strFile$
   
5.     Dim i As Long
   
6.     On Error GoTo ErrorHandler:
   
7. 
   
8.     strFile = ThisWorkbook.Path & Application.PathSeparator & Format(Now, "yyyymmddhhmm") & ".txt"
   
9.     fileNO = FreeFile
   
10.     Open strFile For Output Access Write As #fileNO
    
11.     arr = Range("a1").CurrentRegion
    
12.     For i = 1 To UBound(arr)
    
13.         'Print #fileNO, arr(i, 1) & "," & arr(i, 3) & "," & arr(i, 5)
    
14.         Write #fileNO, arr(i, 1), arr(i, 3), arr(i, 5)
    
15.     Next
    
16.     Close #fileNO
    
17.     MsgBox "文件导出到 " & strFile
    
18.     Exit Sub
    
19.    
    
20. ErrorHandler:
    
21.     MsgBox Err.Number & vbCrLf & _
    
22.            Err.Description
    
23.     Err.Clear
    
24.     Close #fileNO
    
25. End Sub
    

复制代码

hwc2ycy

ErrorHandler:
    MsgBox Err.Number & vbCrLf & _
           Err.Description
    Err.Clear
    Close #fileNO
这里的CLOSE语句兴许可以不要

qqyyh

不必用VBA,用EXCEL另存为txt文件即可：
A              B              C               D              E             F
1        ，        3        ，        7        ；
1        ，        3        ，        7        ；
1        ，        3        ，        7        ；
1        ，        3        ，        7        ；
1        ，        3        ，        7        ；
1        ，        3        ，        7        ；
1        ，        3        ，        7        ；
1        ，        3        ，        7        ；
1        ，        3        ，        7        ；
1        ，        3        ，        7        ；
1        ，        3        ，        7        ；
在BDF列添加，；，再将excel文件另存为后缀名为txt文件。更适合不懂vba的人。

hwc2ycy

如果你的工作表内BD列无数据的话，那我的代码就不适用了。

zhxqer

hwc2ycy 发表于 2013-6-21 16:44

下标越界
这个是什么意思，新手

zhxqer

zhxqer 发表于 2013-6-21 17:33
下标越界
这个是什么意思，新手

搞懂了，谢谢啊！~~