[已解决]如何修改这个excel按行分割成多个txt的代码？谢谢！

bipl607

在网上找了一个excel按行数分割成多个txt的代码，但运行结果却只有空文档没有内容，请大家抽些时间看看什么问题，谢谢！详见附件

注：正确的P001.TXT应该有内容：1362140101        82        111        53        59        63        63        431

最佳答案

月排行榜 / 总排行榜

爱疯

2016-2-17 11:41

Sub test3()
    Dim A, i, j, p$, str$
    A = Range("a1:i" & Range("a65536").End(xlUp).Row)
    p = ThisWorkbook.Path & "\"
    For i = 1 To UBound(A, 2)
        str = ""
        For j = 3 To UBound(A, 2)
            str = str & A(i, j) & vbTab
        Next j
        Open p & A(i, 1) & ".txt" For Binary As #1
        Put #1, , str
        Close #1
    Next i
End Sub

跳转到最佳答案楼层

爱疯

A列都是不重复的数据吗？

如果是，在第一行手动插入一行标题后，用这工具试试
http://www.excelpx.com/thread-297695-1-1.html

bipl607

谢谢版主，我只想用代码嘛，工具太大，请高手改改，谢谢！

bipl607

再顶下，请高手改改，谢谢！

爱疯

Sub test()
    Dim A, i, j, p$, str$
    A = Range("a1:i" & Range("a65536").End(xlUp).Row)
    p = ThisWorkbook.Path & "\"
   
    For i = 1 To UBound(A, 2)
        str = ""
        For j = 1 To UBound(A, 2)
            str = str & A(i, j) & vbTab
        Next j
        
        Open p & A(i, 1) & ".txt" For Output As #1
        Write #1, str
        Close #1
    Next i
End Sub

爱疯

弄短1点


Sub test()
    Dim A, i%, p$
    A = Range("a1:i" & Range("a65536").End(xlUp).Row)
    p = ThisWorkbook.Path & "\"
    For i = 1 To UBound(A, 2)
        Open p & A(i, 1) & ".txt" For Output As #1
        Write #1, VBA.Join(Application.Index(A, i, 0), vbTab)
        Close #1
    Next i
End Sub

bipl607

爱疯 发表于 2016-2-17 11:03
Sub test()
    Dim A, i, j, p$, str$
    A = Range("a1:i" & Range("a65536").End(xlUp).Row)

爱疯版主，结果是"1362140101                82        111        53        59        63        63        431        "
多了2个"  "
怎么处理？谢谢！

爱疯

Sub test2()
    Dim A, i%, p$
    A = Range("a1:i" & Range("a65536").End(xlUp).Row)
    p = ThisWorkbook.Path & "\"
    For i = 1 To UBound(A, 2)
        Open p & A(i, 1) & ".txt" For Binary As #1
        Put #1, , VBA.Join(Application.Index(A, i, 0), vbTab)
        Close #1
    Next i
End Sub

ghostjiao

1. Sub 每1行分割成1个txt()
   
2.     On Error Resume Next
   
3.     Dim arr, i%, j%, str$, irow%
   
4.     With Sheet1
   
5.         irow = .Cells(.Rows.Count, 1).End(xlUp).Row
   
6.         arr = .Range("a1:i" & irow)
   
7.     End With
   
8.     MkDir ThisWorkbook.Path & "\分割"
   
9.     For i = 1 To UBound(arr)
   
10.         For j = 1 To UBound(arr, 2) - 1
    
11.             str = str & arr(i, j) & vbTab
    
12.         Next
    
13.         str = str & arr(i, j)
    
14.         Open ThisWorkbook.Path & "\分割" & Format(i, "P000") & ".txt" For Binary As #1
    
15.         Put #1, , str
    
16.         Close #1
    
17.         str = ""
    
18.     Next
    
19.     MsgBox "分割完成"
    
20. End Sub

复制代码

bipl607

爱疯 发表于 2016-2-17 11:17
Sub test2()
    Dim A, i%, p$
    A = Range("a1:i" & Range("a65536").End(xlUp).Row)

爱疯版主，受你结果的启发，用A列内容作为文件名，好啊，

此时如果结果中不含A列内容就更好了，

如   82        111        53        59        63        63        431   
怎么处理？谢谢！