5

我需要帮助从名为“工作表”的 Excel 电子表格中的每一行创建单独的文本文件。我希望文本文件以 A 列的内容命名,以 BG 列为内容,最好在文本文件的每一列之间有一个双硬返回,因此每一列之间都有一个空行。

这可能吗?我该怎么办。谢谢!

4

4 回答 4

3

附加的 VBA 宏将执行此操作,将 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
于 2012-10-25T22:46:09.000 回答
3

@nutsch 的回答非常好,应该在 99.9% 的时间内有效。在 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
于 2012-10-26T00:56:51.790 回答
2

为了他人的利益,我解决了这个问题。我用“Chr(13) & Chr(10)”替换了“Chr(10) & Chr(10)”,效果很好。

于 2013-05-18T17:37:37.543 回答
2

很长一段时间以来,我使用下面的简单代码将我的 excel 行保存为文本文件或许多其他格式,它一直对我有用。

Sub savemyrowsastext()
Dim x

For Each cell In Sheet1.Range("A1:A" & Sheet1.UsedRange.Rows.Count)
' 您可以将 sheet1 更改为您自己的选择
saveText = cell.Text
Open "C:\wamp\ www\GeoPC_NG\sogistate\igala_land\" & saveText & ".php" For Output As #1
Print #1, cell.Offset(0, 1).Text
Close #1
For x = 1 To 3 ' 循环 3 次。
Beep ' 发出声音。
下一个 x
下一个单元格
End Sub

注意:

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,您可以将扩展名更改为您自己的选择(.txt、.htm & . csv 等)我在每次保存结束时都包含了 bip 声音,以了解我的工作是否正在进行
Dim x
For x = 1 To 3 ' 循环 3 次。
Beep ' 发出声音。

于 2013-07-18T16:49:24.060 回答