[已解决]请求哪位老师可以帮帮我，俺解决不了

s1985926

我需要把excel的内容导入到txt（格式要跟txt中的一样）， 桌面.rar (6.87 KB, 下载次数: 13)

2012-5-23 10:13 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

hrpotter

2012-5-23 11:11

1. Sub test()
   
2.     Dim ar
   
3.     Dim i As Integer, j As Integer
   
4.     Dim fs, f, s
   
5.     Set fs = CreateObject("Scripting.FileSystemObject")
   
6.     Set f = fs.CreateTextFile(ThisWorkbook.Path & "\123-1.txt", True)
   
7.     ar = Range("a1").CurrentRegion
   
8.     For i = 1 To UBound(ar)
   
9.         s = ""
   
10.         For j = 1 To UBound(ar, 2)
    
11.             If ar(i, j) <> "" Then
    
12.                 If s = "" Then
    
13.                     s = ar(i, j)
    
14.                 Else
    
15.                     s = s & "," & ar(i, j)
    
16.                 End If
    
17.             End If
    
18.         Next
    
19.         f.WriteLine (s)
    
20.     Next
    
21.     f.Close
    
22.     Set f = Nothing
    
23.     Set fs = Nothing
    
24. End Sub

复制代码

跳转到最佳答案楼层

hrpotter

1. Sub test()
   
2.     Dim ar
   
3.     Dim i As Integer, j As Integer
   
4.     Dim fs, f, s
   
5.     Set fs = CreateObject("Scripting.FileSystemObject")
   
6.     Set f = fs.CreateTextFile(ThisWorkbook.Path & "\123-1.txt", True)
   
7.     ar = Range("a1").CurrentRegion
   
8.     For i = 1 To UBound(ar)
   
9.         s = ""
   
10.         For j = 1 To UBound(ar, 2)
    
11.             If ar(i, j) <> "" Then
    
12.                 If s = "" Then
    
13.                     s = ar(i, j)
    
14.                 Else
    
15.                     s = s & "," & ar(i, j)
    
16.                 End If
    
17.             End If
    
18.         Next
    
19.         f.WriteLine (s)
    
20.     Next
    
21.     f.Close
    
22.     Set f = Nothing
    
23.     Set fs = Nothing
    
24. End Sub

复制代码

wayy

录个另存为的代码，然后另存为csv格式的就可以了，然后改为txt格式的就行了。

changxuegu123

1. Sub 按钮1_单击()
   
2. Dim ss As String
   
3. filepath = ThisWorkbook.Path
   
4. Open filepath & "" & "123-1.txt" For Append As #1
   
5. arr = Sheet1.Range("a1").CurrentRegion
   
6. For r = 1 To UBound(arr, 1)
   
7.     s = ""
   
8.     For c = 1 To UBound(arr, 2)
   
9.     If arr(r, c) <> "" Then
   
10.         s = s & arr(r, c) & ","
    
11.     End If
    
12.     Next
    
13.     Print #1, Right(s, Len(s) - 1)
    
14. Next
    
15. Close #1
    
16. End Sub

复制代码