从Excel电子表格的每一行创build文本文件

我需要帮助创build单独的文本文件从Excel工作表的Excel电子表格中的每一行。 我希望文本文件以列A的内容命名，列BG是内容，最好是在文本文件中的每一列之间使用双重硬返回，因此每列之间将有一个空行。

这可能吗？ 我将如何去做。 谢谢！

Answer 1

@ nutsch的答案是完美的，应该工作99.9％的时间。 在很less的情况下，FSO不可用，这里是一个没有依赖的版本。 因为它确实要求源工作表在内容部分没有任何空行。

Sub SaveRowsAsCSV() Dim wb As Excel.Workbook, wbNew As Excel.Workbook Dim wsSource As Excel.Worksheet, wsTemp As Excel.Worksheet Dim r As Long, c As Long Set wsSource = ThisWorkbook.Worksheets("worksheet") Application.DisplayAlerts = False 'will overwrite existing files without asking r = 1 Do Until Len(Trim(wsSource.Cells(r, 1).Value)) = 0 ThisWorkbook.Worksheets.Add ThisWorkbook.Worksheets(1) Set wsTemp = ThisWorkbook.Worksheets(1) For c = 2 To 7 wsTemp.Cells((c - 1) * 2 - 1, 1).Value = wsSource.Cells(r, c).Value Next c wsTemp.Move Set wbNew = ActiveWorkbook Set wsTemp = wbNew.Worksheets(1) 'wbNew.SaveAs wsSource.Cells(r, 1).Value & ".csv", xlCSV 'old way wbNew.SaveAs "textfile" & r & ".csv", xlCSV 'new way 'you can try other file formats listed at http://msdn.microsoft.com/en-us/library/office/aa194915(v=office.10).aspx wbNew.Close ThisWorkbook.Activate r = r + 1 Loop Application.DisplayAlerts = True End Sub 

Answer 2

我使用下面的简单代码来保存我的excel行作为一个文本文件或许多其他格式相当长的一段时间，它一直为我工作。

Sub savemyrowsastext（）
Dim x

对于Sheet1.Range中的每个单元格（“A1：A”＆Sheet1.UsedRange.Rows.Count）
'您可以将sheet1更改为您自己的select
saveText = cell.Text
打开“C：\ wamp \ www \ GeoPC_NG \ sogistate \ igala_land \”＆saveText＆“.php”输出为＃1
打印＃1，cell.Offset（0，1）.Text
closures＃1
对于x = 1到3'循环3次。
哔哔声听起来很有声调。
下一个x
下一个单元格
结束小组

注意：

1.列A1 =文件标题
2.列B1 =文件内容
3.直到最后一行包含文本（即空行）

以相反的顺序，如果你想这样做;

1.列A1 =文件标题
2.列A2 =文件内容
3.直到最后一行包含文本（即空行），只要将Print＃1，cell.Offset（0,1）.Text更改为Print＃1，cell.Offset（1,0）.Text

我的文件夹位置= C：\ wamp \ www \ GeoPC_NG \ kogistate \ igala_land \
我的文件扩展名= .php，你可以根据自己的select更改扩展名（.txt，.htm和.csv等）。在每次保存结束时，我都会收到bip声音，以了解我的工作是否正在进行
Dim x
对于x = 1到3'循环3次。
哔哔声听起来很有声调。

Answer 3

附带的VBAmacros将执行它，将txt文件保存在C：\ Temp \

 Sub WriteTotxt() Const forReading = 1, forAppending = 3, fsoForWriting = 2 Dim fs, objTextStream, sText As String Dim lLastRow As Long, lRowLoop As Long, lLastCol As Long, lColLoop As Long lLastRow = Cells(Rows.Count, 1).End(xlUp).Row For lRowLoop = 1 To lLastRow Set fs = CreateObject("Scripting.FileSystemObject") Set objTextStream = fs.opentextfile("c:\temp\" & Cells(lRowLoop, 1) & ".txt", fsoForWriting, True) sText = "" For lColLoop = 1 To 7 sText = sText & Cells(lRowLoop, lColLoop) & Chr(10) & Chr(10) Next lColLoop objTextStream.writeline (Left(sText, Len(sText) - 1)) objTextStream.Close Set objTextStream = Nothing Set fs = Nothing Next lRowLoop End Sub 

Answer 4

为了别人的利益，我把问题整理出来了。 我用“Chr（13）＆Chr（10）”取代了“Chr（10）＆Chr（10）”，并且完美运作。