☰

使用第一列作为名称输入从 Excel 创建文本文件

tag-icon • tag-icon microsoft-excel microsoft-excel-2010 vba
使用第一列作为名称输入从 Excel 创建文本文件

我已尝试制作我的第一个 VBA 宏。

当我尝试运行它时出现错误，为什么？

任何人都可以修复它以使其工作（即首先使用第一列作为文本名称，将所有其他列用作文件中的文本，并且下一列，行具有与前一列相同的名称，我希望它将该行写入同一个文本文件，但向下一行）

例子

Colum1      Coulum2

object1      value1

object2      value2

object3      value3

object3      value4

object4      value5

文本文件 1 object1.txt 文件内部

值 1

文本文件 2 object2.txt 内部文件

值 2

文本文件 3 object3.txt 内部文件

值 3

值 4（“仍然是同一个文件”）

文本文件 4 object4.txt 文件内部

值 5

代码：

Sub CreateFile()
    Do While Not IsEmpty(ActiveCell.Offset(0, 1))
        MyFile = ActiveCell.Value & ".txt"
        'set and open file for output
        fnum = FreeFile()
        Open MyFile For Output As fnum
        'use Print when you want the string without quotation marks
        n = 0
        If ActiveCell.Offset(n, 0) = ActiveCell.Offset(0 - 1, 1).Select Then
            Close #fnum
            Return
        Else: ActiveCell.Offset(n, 0) = ActiveCell.Offset(0, 1)
            Print #fnum, ActiveCell.Offset(n, 1) & " " & ActiveCell.Offset(n, 2)
            n = n + 1
    ActiveCell.Offset(1, 0).Select
    Loop
End Sub

答案1

Option Explicit

Sub CreateFileEachLine()

    Dim myPathTo As String
    myPathTo = "C:\usr...."
    Dim myFileSystemObject As Object
    Set myFileSystemObject = CreateObject("Scripting.FileSystemObject")
    Dim fileOut As Object
    Dim myFileName As String

    Dim lastRow As Long
    lastRow = Cells(Rows.Count, 1).End(xlUp).Row
    Dim i As Long
    i = 0
    Do While i < lastRow
        myFileName = myPathTo & ActiveCell.Value & ".txt"
        Set fileOut = myFileSystemObject.CreateTextFile(myFileName)
        Do While (ActiveCell.Offset(0, 0) = ActiveCell.Offset(1, 0))
        fileOut.write ActiveCell.Offset(0, 1) & " " & ActiveCell.Offset(0, 2)

        ActiveCell.Offset(1, 0).Select
        i = i + 1
        Loop
    fileOut.Close
    ActiveCell.Offset(1, 0).Select
    i = i + 1
    Loop
End Sub

帮助来自：Excel - 创建以包含其他单元格数据的单元格命名的文本文件

答案2

修复

Sub CreateFile()
    Close #fnum
    Close MyFile
    myPathTo = "C:\Users\tianr\Downloads\Ny mapp\"


    Dim lastRow As Long
    lastRow = Cells(Rows.Count, 1).End(xlUp).Row
    Dim i As Long
    i = 0
    Do While i < lastRow
        MyFile = myPathTo & ActiveCell.Value & ".txt"
        fnum = FreeFile()
        Open MyFile For Output As fnum
        Do While (ActiveCell.Offset(0, 0) = ActiveCell.Offset(1, 0))
        Print #fnum, ActiveCell.Offset(0, 1) & " " & ActiveCell.Offset(0, 2) & " " & ActiveCell.Offset(0, 3) & " " & ActiveCell.Offset(0, 4) & " " & ActiveCell.Offset(0, 5) & " " & ActiveCell.Offset(0, 6) & " " & ActiveCell.Offset(0, 7) & " " & ActiveCell.Offset(0, 8) & " " & ActiveCell.Offset(0, 9) & " " & ActiveCell.Offset(0, 10) & " ; "
        ActiveCell.Offset(1, 0).Select
        i = i + 1
        Loop
    Close #fnum
    ActiveCell.Offset(1, 0).Select
    i = i + 1
    Loop
End Sub

相关内容