用相同的格式将excel文件导出到txt

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

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

我需要导出这个文件相同的空格,相同的格式在一个TXT文件。 我该怎么做? 我尝试了Save As | Formatted Text (Space Delimited) (*.prn) Save As | Formatted Text (Space Delimited) (*.prn)但不工作,因为我在最后一列的问题。 有macros吗? 谢谢。

编辑:我试了一个macros:

 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列! 无论如何,问题是,如果在第一列有一个较短的价值,那么其他人失去了格式,如第二行,你可以看到。

您发布的数据显示字段宽度为8,7,7,4的固定字段(每个字段是字符和尾随空白的组合)。 这些可以在下面的macros中根据需要进行调整。 还要调整文件夹名称以满足您的需求:

 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列开始。

我也无数次地苦苦挣扎,唯一的办法就是用我创build的VBA函数(这个棘手的部分是确定纯文本布局的“最宽”的列)。 公平的警告:我并没有在这方面build立很多“智慧”,输出可能会有些古怪。

用法:select你想格式化为纯文本的单元格,然后运行macros(我把macros分配给一个button,我一直使用它!)。 如果最上面的一行是中心alignment的,那么让我们假设它是一个标题。 注意右alignment的列,并输出右alignment的列。

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