excel - 如何将所有行数据附加到与来自不同行的同一文件关联的相同文件名中

Question

我正在尝试基于 A 列生成文件，并将行数据写入生成的文件中。我可以用下面的代码来实现。

问题：如果一个文件名出现多次，我想将所有行数据附加到与不同行的相同文件名关联的相同文件名中。

到目前为止，它会选择与 A 列中的文件名相关联的最后一行并生成一个文件。

如何将所有行数据附加到一个文件中。

我的代码，

Sub ExportToNotepad()
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Dim oFile As Object

Dim i&, lastRow&
lastRow = Cells(Rows.Count, 1).End(xlUp).Row

For i = 2 To lastRow
Set oFile = fso.CreateTextFile("C:\WriteToFile\" & Cells(i, 1) & ".xml")

oFile.WriteLine Cells(i, 2).Value
oFile.Close

Next i
Set fso = Nothing
Set oFile = Nothing

End Sub

问题图像，

标签： excelvba

Answer 1

可能是这样的：

Sub test()
Set rngSource = Range("A1", Range("A" & Rows.Count).End(xlUp))

rngSource.Copy Range("AA1")
Range("AA:AA").RemoveDuplicates Columns:=1, Header:=xlNo
Set rngUnique = Range("AA1", Range("AA" & Rows.Count).End(xlUp))

Set lr = Cells(rngSource.Rows.Count, rngSource.Column)
Set fso = CreateObject("Scripting.FileSystemObject")

For Each cell In rngUnique
n = Application.CountIf(rngSource, cell.Value)
Set c = rngSource.Find(cell.Value, lookat:=xlWhole, after:=lr)

Set oFile = fso.CreateTextFile("C:\WriteToFile\" & cell.Value & ".xml")
For i = 1 To n
oFile.WriteLine c.Offset(0, 1).Value
Set c = rngSource.FindNext(c)
Next i
Next

rngUnique.ClearContents
End Sub

此代码使用列帮助器（AA 列）获取唯一值，以防另一个相同的值出现在不连续的行中。请确保 AA 列中没有重要的文本/值。