Question

我有一个excel电子表格，格式如下。

第1栏：AAA BBB AAA BBB DDD BBB CCC BBB CCC

第2栏：Fox虎猴鸟猫狼狗猪

我想使用第1列作为文件名----“AAA”，“BBB”，“CCC”，“DDD”将它们保存为多个文本文件。内容应该是第2列。每个文本文件应该有多行。

例如，在文本文件“AAA”中，内容应为：

福克斯猴

我现在使用以下VBA脚本。但是对于每个文本文件，我只能生成一行。

Sub Export_Files()
Dim sExportFolder, sFN
Dim rArticleName As Range
Dim rDisclaimer As Range
Dim oSh As Worksheet
Dim oFS As Object
Dim oTxt As Object

'sExportFolder = path to the folder you want to export to
'oSh = The sheet where your data is stored
sExportFolder = "I:\Projects\2017\Two_Weeks_Vacations\2017\December\Test\EmployeesOnVacation"
Set oSh = Sheet1

Set oFS = CreateObject("Scripting.Filesystemobject")

For Each rArticleName In oSh.UsedRange.Columns("A").Cells
    Set rDisclaimer = rArticleName.Offset(, 1)

    'Add .txt to the article name as a file name
    sFN = rArticleName.Value & ".txt"
    Set oTxt = oFS.OpenTextFile(sExportFolder & "\" & sFN, 2, True)
    oTxt.Write rDisclaimer.Value
    oTxt.Close
Next
End Sub

Answer 1

如果您可以排序，那么您可以使用基本模板：

Public a as String

Sub 
    Dim i as Long, lr as Long, strO as String, strN as String
    LR = Cells(Rows.Count, 1).End(xlUp).Row
    For i = i to lr Step 1
        strO = a
        If Cells(i,1).Value = Cells(i-1,1).Value Then
            If a <> "" Then Export_Files 'Calls the Sub that names the file... or you can just name and do that stuff here.
            a = ""
            strO = Cells(i,2).Value
        Else
            strN = Cells(i,2).Value
        End If
        a = strO & " " & strN
    Next i
    Export_Files
    a = ""
End Sub

然后需要修复Export_Files宏的命名，删除选择文件名的部分并更改总文件保存名称：

Set oTxt = oFS.OpenTextFile(sExportFolder & "\" & a, 2, True)

如何根据列名输出多个文本文件？

1 个答案: