vba 将每个 Excel 行写入新的 .txt 文件，其中 ColumnA 作为文件名
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/15554099/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Write each Excel row to new .txt file with ColumnA as file name
提问by eke
I would be extremely grateful for any help as I have just begun to look into writing Excel macros.
我将非常感谢任何帮助，因为我刚刚开始研究编写 Excel 宏。
I have excel documents with about 1,500 rows and variable column lengths, from 16-18. I would like to write each row of the file to a new .txt file (actually, I would REALLY like to write it as a .pdf but I don't think that's possible) where the name of the file is the corresponding first column. Additionally, I would like each row to be separated by a new line. So, ideally, the macro would 1) export each row as a new .txt file (or .pdf if possible), 2) name each file as ColumnA, 3) the content of each new .txt file would contain ColumnsB-length of total columns 4) each column is separated by a new line.
我有大约 1,500 行和可变列长度的 excel 文档，从 16 到 18。我想将文件的每一行写入一个新的 .txt 文件（实际上，我真的很想将它写为 .pdf，但我认为这是不可能的），其中文件的名称是相应的第一列. 此外，我希望每一行都用新行分隔。因此，理想情况下，宏将 1) 将每一行导出为一个新的 .txt 文件（或 .pdf，如果可能），2) 将每个文件命名为 ColumnA，3) 每个新 .txt 文件的内容将包含 ColumnsB 长度总列数 4) 每列由一个新行分隔。
For example, if the document looks like this:
例如，如果文档如下所示：
column 1//column 2// column3
a//a1//a2
b//b1//b2
第 1 列//第 2 列// 第 3 列
一个//a1//a2
b//b1//b2
I want it to output to be 2 files, named "a", "b". As an example, the contents of file "a" would be:
我希望它输出为 2 个文件，分别命名为“a”、“b”。例如，文件“a”的内容是：
a1
a2
a1
a2
I have found 2 other stack overflow threads addressing separate pieces of my question, but I am at a loss as to how to stitch them together.
我发现另外 2 个堆栈溢出线程解决了我的问题的不同部分，但我不知道如何将它们拼接在一起。
Each row to new .txt file, with a newline between each column (but file name not ColumnA): Create text Files from every row in an Excel spreadsheet
每行到新的 .txt 文件，每列之间有一个换行符（但文件名不是 ColumnA）： 从 Excel 电子表格中的每一行创建文本文件
Only one column incorporated into file, but file names correspond with ColumnA: Outputting Excel rows to a series of text files
只有一列并入文件，但文件名与 ColumnA 相对应：将 Excel 行输出到一系列文本文件
Thank you for any help!
感谢您的任何帮助！
回答by David Zemens
To get the contents to be columns B thru the end of the file, you could do something like this.
要使内容成为文件末尾的 B 列，您可以执行以下操作。
Create a simple loop over the cells in Column B. This defines a range of columns for each row, and also sets a filename based on the value in column A.
在 B 列的单元格上创建一个简单的循环。这定义了每行的列范围，并根据 A 列中的值设置文件名。
Sub LoopOverColumnB()
Dim filePath as String
Dim fileName as String
Dim rowRange as Range
Dim cell as Range
filePath = "C:\Test\" '<--- Modify this for your needs.
For each cell in Range("B1",Range("B1048576").End(xlUp))
Set rowRange = Range(cell.address,Range(cell.address).End(xlToRight))
fileName = filePath & cell.Offset(0,-1).Value
'
' Insert code to write the text file here
'
' you will be able to use the variable "fileName" when exporting the file
Next
End Sub
回答by eke
I ended up stitching the following together to solve my problem, thanks entirely to @David and @Exactabox. It is incredibly inefficient and has redundant bits, but it runs (Very. Slowly). If anyone can spot how to clean it up, feel free, but otherwise it gets the job done.
我最终将以下内容拼接在一起以解决我的问题，这完全归功于 @David 和 @Exactabox。它非常低效并且有冗余位，但它运行（非常。缓慢）。如果有人能发现如何清理它，请随意，否则它就可以完成工作。
[edit] Unfortunately I now realize that although this macro exports each row as an appropriately named new .txt file, the content of each text file is the last row of the document. So even if it exports all 20 lines as 20 .txt files with an appropriate file name and correct formatting, the actual content of each of the 20 files is the same. I am unsure how to rectify this.
[编辑] 不幸的是，我现在意识到虽然这个宏将每一行导出为一个适当命名的新 .txt 文件，但每个文本文件的内容都是文档的最后一行。因此，即使将所有 20 行导出为具有适当文件名和正确格式的 20 个 .txt 文件，这 20 个文件中每个文件的实际内容都是相同的。我不确定如何纠正这个问题。
Sub SaveRowsAsTXT()
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
Dim filePath As String
Dim fileName As String
Dim rowRange As Range
Dim cell As Range
filePath = "C:\filepath\"
For Each cell In Range("B1", Range("B1048576").End(xlUp))
Set rowRange = Range(cell.Address, Range(cell.Address).End(xlToRight))
fileName = filePath & cell.Offset(0, -1).Value
Set wsSource = ThisWorkbook.Worksheets("Sheet1")
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 16
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 fileName & ".txt", xlTextWindows 'save as .txt
wbNew.Close
ThisWorkbook.Activate
r = r + 1
Loop
Application.DisplayAlerts = True
Next
End Sub
回答by RAHMAD
This should fix the problem of getting the same data in all the files:
这应该可以解决在所有文件中获取相同数据的问题：
Sub SaveRowsAsTXT()
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
Dim filePath As String
Dim fileName As String
Dim rowRange As Range
Dim cell As Range
filePath = "C:\Users\Administrator\Documents\TEST\"
For Each cell In Range("B1", Range("B10").End(xlUp))
Set rowRange = Range(cell.Address, Range(cell.Address).End(xlToRight))
Set wsSource = ThisWorkbook.Worksheets("Sheet1")
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 16
wsTemp.Cells((c - 1) * 2 - 1, 1).Value = wsSource.Cells(r, c).Value
Next c
fileName = filePath & wsSource.Cells(r, 1).Value
wsTemp.Move
Set wbNew = ActiveWorkbook
Set wsTemp = wbNew.Worksheets(1)
wbNew.SaveAs fileName & ".txt", xlTextWindows 'save as .txt
wbNew.Close
ThisWorkbook.Activate
r = r + 1
Loop
Application.DisplayAlerts = True
Next
End Sub
回答by J. Dark
@danfo, I don't know if this will be useful to you, but after some fiddling, I did get this working. I needed to make sure that all my top row was written with no spaces or special characters; and my left column needed to be ID numbers, rather than dates or anything else -- but once I'd fixed those things, it worked fine.
@danfo，我不知道这对您是否有用，但经过一番摆弄后，我确实得到了它。我需要确保我的所有顶行都没有空格或特殊字符；我的左栏需要是 ID 号，而不是日期或其他任何东西——但是一旦我修复了这些东西，它就可以正常工作。
