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 列あるため、これらの値は一例です。とにかく問題は、最初の列に他の列よりも短い値がある場合、ご覧のように 2 行目のような書式設定が失われることです。

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関数を使用することでした(トリッキーな部分は、プレーンテキストレイアウトの「最も広い」列を決定することです)。公正な警告: 私はこれに多くの「スマート」を組み込みませんでした。出力は少し風変わりになる可能性があります。

使用法: プレーンテキストに書式設定するセルを選択し、マクロを実行します (ボタンにマクロを割り当てて、常に使用しています!)。一番上の行が中央揃えの場合は、それがヘッダーであると/仮定/しましょう。右揃えの列を監視し、右揃えで出力します。

マルコは目的の出力をクリップボードにコピーし、結果をメモ帳 (または同様のもの) に貼り付けて、必要に応じて処理します。

出力例 (いくつかのヘッダーを挿入しました)

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 に答える