0

我有一个这样写的excel文件：

187712  201    37     0.18   
2525    580    149    0.25   
136829  137    43     0.31

我需要在 txt 文件中使用相同的空格、相同的格式导出此文件。我该怎么做？我试过Save As | Formatted Text (Space Delimited) (*.prn)但没有工作，因为我在最后一列有问题。有宏吗？谢谢。

编辑：我尝试了一个宏：

Sub TEST()
    Dim c As Range, r As Range
    Dim output As String
    For Each r In Range("A1:L504").Rows
        For Each c In r.Cells
            output = output & " " & c.Value
        Next c
        output = output & vbNewLine
    Next r
    Open "D:\MyPath\text.txt" For Output As #1
    Print #1, output
    Close
End Sub

但结果是

187712  201    37     0.18   
2525 580  149    0.25   
136829  137    43     0.31

这些值只是一个示例，因为大约有 504 列！无论如何，问题是如果在第一列中有一个值比其他值更短，它会丢失格式，如您所见的第二行。

4

2 回答 2

1

您发布的数据显示字段宽度为 8、7、7、4 的固定字段（每个字段都是字符和尾随空格的组合）。这些可以在下面的宏中根据需要进行调整。还要调整文件夹名称以满足您的需要：

Sub FixedField()

    Dim fld(1 To 4) As Long
    Dim V(1 To 4) As String
    Dim N As Long, L As Long
    Dim K As Long

    fld(1) = 8
    fld(2) = 7
    fld(3) = 7
    fld(4) = 4
    N = Cells(Rows.Count, "A").End(xlUp).Row
    Close #1
    Open "c:\TestFolder\test.txt" For Output As #1

    For L = 1 To N
        outpt = ""
        For K = 1 To 4
            V(K) = Cells(L, K).Text
            While Len(V(K)) <> fld(K)
                V(K) = V(K) & " "
            Wend
            outpt = outpt & V(K)
        Next K
        MsgBox outpt
        Print #1, outpt
    Next L
    Close #1
End Sub

还假设数据从 A 列开始。

于 2013-10-09T14:32:32.150 回答
1

我也多次为此苦苦挣扎，我发现的唯一方法是使用我创建的 VBA 函数（棘手的部分是确定纯文本布局的“最宽”列）。公平警告：我没有在其中构建很多“智能”，输出可能有点古怪。

用法：选择要格式化为纯文本的单元格，然后运行宏（我已将宏分配给按钮，我一直都在使用它！）。如果顶行是居中对齐的，那么让我们 /assume/ 它是一个标题。并注意右对齐的列，并输出那些右对齐的。

marco 会将所需的输出复制到剪贴板，然后将结果粘贴到记事本（或类似工具）中以根据需要进行处理。

示例输出（我输入了一些标题）

CustId  Views  Selected  Cost
187712    201        37  0.18
  2525    580       149  0.25
136829    137        43  0.31

编码：

Sub FormatSelectionToPlainText()
  ' ---------------------------------------------------------------------------
  ' Author: Jay R. Ohman
  ' Ohman Automation Corp., http://www.OhmanCorp.com
  ' ** disclaimer and release: I am NOT an expert  **
  ' ** programmer, use my coding at your own risk! **
  ' ---------------------------------------------------------------------------
  Dim rFound As Range, RngCol1 As Integer, RngRow1 As Integer, ActCol As Integer, ActRow As Integer, x As Integer
  Dim MaxCellLen() As Variant, CellAlignRight() As Variant, HdrLen() As Variant, xDbg As Boolean, xVal As Variant
  Dim SepSpace As Integer, RetStr As String, RetLen As Integer, MsgStr As String, HasHdr As Boolean
  Dim GeneralIsRightAlignedFactor As Single, TotalRows As Integer
  Dim oClip As DataObject

  xDbg = True                                                        ' output stuff to the immediate window?
  GeneralIsRightAlignedFactor = 0.75                                 ' threshhold for deeming a column as right-aligned
  Set oClip = New DataObject
  MsgStr = "(looking for top row to be center aligned as header)"
  If MsgBox("Are the cells to be copied selected?" & vbCrLf & MsgStr, vbYesNo + vbQuestion, "Auto-Fill Time Slots") = vbYes Then
    If (Selection Is Nothing) Then
      MsgBox "Nothing Selected."
    Else
      SepSpace = 2                                                   ' number of spaces between columns
      RetLen = 0
      HasHdr = True
      Set rFound = Selection
      RngCol1 = rFound.Column
      RngRow1 = rFound.Row
      Debug.Print Selection.Columns.Count
      ReDim Preserve MaxCellLen(Selection.Columns.Count)             ' max cell length
      ReDim Preserve CellAlignRight(Selection.Columns.Count)         ' track the cell alignment
      ReDim Preserve HdrLen(Selection.Columns.Count)                 ' header row max cell length
      For ActCol = RngCol1 To RngCol1 + Selection.Columns.Count - 1
        x = (ActCol - RngCol1 + 1)
        ' If xDbg Then Debug.Print Cells(RngRow1, ActCol).HorizontalAlignment
        If (Cells(RngRow1, ActCol).HorizontalAlignment <> xlCenter) And (Cells(RngRow1, ActCol).Value <> "") Then HasHdr = False
        HdrLen(x) = IIf(HasHdr, Len(Cells(RngRow1, ActCol).Value), 0)
        MaxCellLen(x) = 0
        CellAlignRight(x) = 0
      Next
      If xDbg Then Debug.Print "HasHdr: " & HasHdr
      TotalRows = (RngRow1 + Selection.Rows.Count) - (RngRow1 + IIf(HasHdr, 1, 0))
      For ActCol = RngCol1 To RngCol1 + Selection.Columns.Count - 1  ' go find the longest text in each column
        x = (ActCol - RngCol1 + 1)
        xVal = IIf(HasHdr, 1, 0)
        For ActRow = RngRow1 + xVal To RngRow1 + Selection.Rows.Count - 1
          ' If xDbg Then Debug.Print Cells(ActRow, ActCol).HorizontalAlignment
          xVal = Cells(ActRow, ActCol).Value
          If (MaxCellLen(x) < Len(Cells(ActRow, ActCol).Value)) Then MaxCellLen(x) = Len(xVal)
          If (Cells(ActRow, ActCol).HorizontalAlignment = xlRight) Or _
              ((Cells(ActRow, ActCol).HorizontalAlignment = xlGeneral) And (IsDate(xVal) Or IsNumeric(xVal))) Then _
                  CellAlignRight(x) = CellAlignRight(x) + 1
        Next
        If xDbg Then Debug.Print "Max Length for Column " & ActCol & ": " & MaxCellLen(x) & _
            ", CellAlignRight.Count: " & CellAlignRight(x) & "/" & TotalRows
        RetLen = RetLen + MaxCellLen(x) + SepSpace
      Next
      RetLen = RetLen - SepSpace                                     ' subtract that last separator space
      If HasHdr Then
        For ActCol = RngCol1 To RngCol1 + Selection.Columns.Count - 1
          x = (ActCol - RngCol1 + 1)
          If (HdrLen(x) > MaxCellLen(x)) Then MaxCellLen(x) = HdrLen(x)
        Next
      End If
      RetStr = ""                                                    ' build the output text
      For ActRow = RngRow1 To RngRow1 + Selection.Rows.Count - 1
        For ActCol = RngCol1 To RngCol1 + Selection.Columns.Count - 1
          x = (ActCol - RngCol1 + 1)
          MsgStr = Cells(ActRow, ActCol).Value                       ' re-use string variable
                                                                     ' format for right-aligned
          If (CellAlignRight(x) / TotalRows >= GeneralIsRightAlignedFactor) And (Not (HasHdr And (ActRow = 1))) Or (Cells(ActRow, ActCol).HorizontalAlignment = xlRight) Then    ' aligned right
            RetStr = RetStr & Space(MaxCellLen(x) - Len(MsgStr)) & MsgStr
          ElseIf (Cells(ActRow, ActCol).HorizontalAlignment = xlCenter) Then
            xVal = Fix((MaxCellLen(x) - Len(MsgStr)) / 2)
            RetStr = RetStr & Space(xVal) & MsgStr & Space(MaxCellLen(x) - Len(MsgStr) - xVal)
          Else
            RetStr = RetStr & MsgStr & Space(MaxCellLen(x) - Len(MsgStr))
          End If
          If ((ActCol - RngCol1) + 1 < UBound(MaxCellLen)) Then RetStr = RetStr & Space(SepSpace)
        Next
        RetStr = RetStr & vbCrLf
      Next
      oClip.SetText RetStr
      oClip.PutInClipboard
      MsgBox ("The selection has been copied to clipboard." & vbCrLf & "Max line length: " & RetLen)
    End If
  Else
    MsgBox ("Have a nice day. :)")
  End If
End Sub
于 2013-10-09T13:18:23.247 回答