☰

如何根据 Excel 中的列值创建文本文件？

tag-icon • tag-icon microsoft-excel vba
如何根据 Excel 中的列值创建文本文件？

我是 VBA 新手，我一直手动操作。我需要自动为 A 列中的每个值创建单独的文本文件。我希望文本文件以 A 列的值命名，BF 列为文本文件的内容，

例如：我有一个主 Excel 文件，其中包含 20000 行（5 列），数据如下：

VendorCode | ItemCode | Price1 | Price2 | Price3 
____________________________________________________
033204     | svk3409  | 23.2   | 23.3   | 23.4
_____________________________________________________
033204     | svk5619  | 24.2   | 24.3   | 24.4
_____________________________________________________
033204     | cli7890  | 34.2   | 34.3   | 34.4
_____________________________________________________
023272     | svk3413  | 18.9   | 18.2   | 18.3
_____________________________________________________
023272     | svk4567  | 90.2   |90.3    | 90.4

到目前为止，我有以下来自参考的代码，但它不会返回每个供应商代码的所有行。它只返回每个 vendorcode.txt 的一行。

Sub SaveRangeToCsvFiles()
    Dim FileName As String
    Dim Ws As Worksheet
    Dim rngDB As Range
    Dim r As Long, c As Long
    Dim pathOut As String
    Dim i As Long

    pathOut = ThisWorkbook.Path & "\" '<~~ set your path:  C:\temp\

    Set Ws = ActiveSheet 'Sheets("AllData")
    With Ws
        r = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        'c = .Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
        For i = 2 To r
            Set rngDB = .Range("a" & i).Resize(1, 6)
            FileName = .Range("a" & i).Offset(, 4)
            TransToCSV pathOut & FileName & ".txt", rngDB
        Next i
    End With
    MsgBox ("Files Saved Successfully")
End Sub


Sub TransToCSV(myfile As String, rng As Range)
    Dim vDB, vR() As String, vTxt()
    Dim i As Long, n As Long, j As Integer
    Dim objStream
    Dim strTxt As String

    Set objStream = CreateObject("ADODB.Stream")
    vDB = rng
    For i = 1 To UBound(vDB, 1)
        n = n + 1
        ReDim vR(1 To UBound(vDB, 2))
        For j = 1 To UBound(vDB, 2)
            vR(j) = vDB(i, j)
        Next j
        ReDim Preserve vTxt(1 To n)
        vTxt(n) = Join(vR, vbTab)
    Next i
    strTxt = Join(vTxt, vbCrLf)
    With objStream
        '.Charset = "utf-8"
        .Open
        .WriteText strTxt
        .SaveToFile myfile, 2
        .Close
    End With
    Set objStream = Nothing
End Sub

编辑：我尝试借助其他资源并更改了代码。见下文。现在它返回每个供应商代码的所有行。与之前的代码不同，它不会覆盖每个供应商文本文件中的行，而是将其附加。但此结果的问题是列在单独的行中。我需要的是将所有列用制表符分隔在同一行中。请告知我如何修复第二个代码。我非常接近我需要实现的目标。

Sub 文件（）

Dim FilePath As String, CellData As String, LastCol As Long, LastRow As Long
Dim Filenum As Integer, loc As String

LastCol = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Column
LastRow = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row

'Application.DefaultFilePath = "C:\Users\9418\Desktop\Work Files"
'loc = Application.DefaultFilePath

For i = 1 To LastRow
    FilePath = Application.DefaultFilePath & "\" & Trim(ActiveSheet.Cells(i, 1).Value) & ".txt"
    Filenum = FreeFile

    Open FilePath For Append As Filenum
    CellData = ""

    For j = 2 To LastCol
    CellData = Trim(ActiveSheet.Cells(i, j).Value)
    Print #Filenum, CellData

    Next j

    Close #Filenum

Next i
MsgBox ("Done")

子目录结束

**最近编辑：**我在这里发布我自己的答案。

在互联网上进一步参考后，我最终想出了下面的代码，该代码在单独的文本文件中返回每个供应商代码的所有行，并且列值也在同一行上。但是，现在这个查询的问题是，在返回一些文本文件后，但当供应商代码的行数更多时，它会给出“溢出”错误。我尝试将主文件中的行分成单独的 excel 文件。每个文件都有 200-500 行。它仍然给我溢出错误。请问有人可以建议我可以做些什么来修复这个错误吗？

选项明确

子创建文件每行（）

Dim myPathTo As String
myPathTo = "\\901db1\IT_Canada\Vending Price Updates"
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

    For i = 2 To lastRow
        If Not IsEmpty(Cells(i, 1)) Then
            myFileName = Cells(i, 1) & ".txt"
            Set fileOut = myFileSystemObject.OpenTextFile(myFileName, 8, True)
            fileOut.write Cells(i, 4) & "   " & Cells(i, 8) & "   " & Cells(i, 8) & "   " & Cells(i, 8) & vbNewLine
            fileOut.Close
        End If
    Next

Set myFileSystemObject = Nothing
Set fileOut = Nothing

子目录结束

答案1

您正在处理一组结构化数据。因此，您上面发布的算法对于您要做的事情来说过于复杂。

我有一个建议（伪代码）是

Set up path (pathOut) and the correct worksheet
Iterate through each row
  If FileName (Cells(1).Text & ".txt") then open file otherwise create new file
  write/append new data (Cells(2) to Cells(5)). ' Do this simply by using the string value & vbTab rather than a more complicated array function. follow up with vbCrLF
  close file

上面的代码很简单，但效率很低（每行代码都执行一次文件操作）。为了提高效率，您可以对行进行排序，以将供应商代码分组，然后只对每个组打开和关闭一次文件。此代码会稍微复杂一些。

[...]
  Set the range for the rows in each group
  Open/create the correct file for write/append
    Iterate through each row and write the data
  Close the file
[...]

对于您描述的简单文本文件，我更喜欢简单的文件操作（例如参见https://www.thespreadsheetguru.com/blog/vba-guide-text-files和https://msdn.microsoft.com/en-us/vba/language-reference-vba/articles/open-statement) 而不是使用流。但是，无论您使用简单的文件操作还是流，您的字符串操作都可以更简单，因为您使用的是结构化数据。更简单的代码使调试和检查变得更容易。

相关内容