时间戳

首页 > 解决方案 > 使用 VBA 将单元格区域转换为列式 txt 文件

excel - 使用 VBA 将单元格区域转换为列式 txt 文件

问题描述

我仍然认为自己是 VBA 的新手，并希望得到任何帮助。有一件事我想知道该怎么做...

我有一个如下所示的工作表，数据从第 16 行开始。我有一个已知的行数（num_rows）。我想遍历每一行。其中 Code = "s" 我想要将数据导出到 s.txt，而 Code = "e" 我想要将数据导出到 e.txt。其他代码出现在代码列中，可以忽略。输出的文件将每一行放在一个新的行上，但也有足够的空间来将数据对齐到仍然在文本文件中的列中。任何指针？

排＃ 代码 标题 姓名 国家
16 s 先生 詹姆斯·史密斯 澳大利亚
17 s 先生 卡尔·伯恩斯 美国
18 e 太太 萨拉·希德 英国

标签： excelvba

解决方案

扫描文件以确定每列的最大宽度。然后再次扫描写出每一行，并用空格填充到所需的宽度。如果您有大量数据，首先将数据复制到数组将减少运行时间。请参阅CreateTextFile和Space

Option Explicit

Sub Macro1()

    Const HEADER_ROW = 15
    Const COL_SPC = 2 ' column spacing

    Dim wb As Workbook, ws As Worksheet
    Set wb = ThisWorkbook
    Set ws = wb.Sheets(1)

    Dim iRow As Long, iLastRow As Long, iLastCol As Integer
    Dim r As Long, c As Integer, s As String, n As Integer
    Dim arWidth() As Integer, arData, arHeader

     ' extent of data
    iLastRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
    iLastCol = ws.Cells(HEADER_ROW, Columns.Count).End(xlToLeft).Column
    arData = ws.Range(ws.Cells(HEADER_ROW + 1, 1), ws.Cells(iLastRow, iLastCol))

    ' max width of each col
    ReDim arWidth(iLastCol)
    ReDim arHeader(iLastCol)
    For c = 1 To UBound(arData, 2)
        s = ws.Cells(HEADER_ROW, c)
        arWidth(c) = Len(s) ' initalise with header width
        For r = 1 To UBound(arData, 1)
           If Len(arData(r, c)) > arWidth(c) Then
               arWidth(c) = Len(arData(r, c))
           End If
         Next
         ' add spacing
         arWidth(c) = arWidth(c) + COL_SPC
         ' space out header
         arHeader(c) = s & Space(arWidth(c) - Len(s))
    Next
     
    'Export Data
    Dim FSO As Object, ts(2), sFileName(2) As String
    Dim sPath As String
    Dim sColB, msg As String
    
    Set FSO = CreateObject("Scripting.FileSystemObject")
    sPath = wb.Path & "\"

    ' create 2 text streams
    n = 1
    For Each sColB In Array("e", "s")
        sFileName(n) = sColB & ".txt"
        Set ts(n) = FSO.CreateTextFile(sPath & sFileName(n), True, True) ' overwrite,unicode
        ' print header
        ts(n).WriteLine Join(arHeader, "")
        n = n + 1
    Next

    ' export data
    For r = 1 To UBound(arData, 1)
        n = 0
        ' choose text stream
        sColB = LCase(Trim(arData(r, 2)))
        If sColB = "e" Then n = 1
        If sColB = "s" Then n = 2

        ' write out 1 line of text
        If n > 0 Then
            s = ""
            For c = 1 To UBound(arData, 2)
               ' space out columns
               s = s & arData(r, c) & Space(arWidth(c) - Len(arData(r, c)))
            Next
            ts(n).WriteLine (s)
            'Debug.Print s
        End If
    Next
    ' close text streams
    For n = 1 To 2
       msg = msg & vbCrLf & sFileName(n)
       ts(n).Close
    Next
    ' finish
    MsgBox "2 Files created in " & sPath & msg

End Sub

推荐阅读