我需要的帮助是使用下面的宏。我首先在excel中创建文件,这个宏以文本格式保存它们。从宏中可以看出,它将所有工作表保存为带制表符分隔的单个文本文件。
如何更改此宏以使用波浪号保存"〜"而不是标签?
Sub newworkbooks()
Dim Sheet As Worksheet, SheetName$, MyFilePath$, N&
MyFilePath$ = ActiveWorkbook.Path & "\" & _
Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - 4)
With Application
.ScreenUpdating = False
.DisplayAlerts = False
' End With
On Error Resume Next '<< a folder exists
MkDir MyFilePath '<< create a folder
For N = 1 To Sheets.Count
Sheets(N).Activate
SheetName = ActiveSheet.Name
Cells.Copy
Workbooks.Add (xlWBATWorksheet)
With ActiveWorkbook
With .ActiveSheet
.Paste
.Name = SheetName
[A1].Select
End With
'save book in this folder
.saveas Filename:=MyFilePath _
& "\PO" & SheetName & ".txt", FileFormat:=xlTextWindows
.Close SaveChanges:=True
End With
.CutCopyMode = False
Next
End With
Sheet1.Activate
End Sub
而不是看起来像以下
this is a test
它看起来像这样
this~is~a~test
答案 0 :(得分:0)
这是一种方法,很容易修改以适应 - 这使您可以控制字符集和分隔符:
https://excel.solutions/2014/04/using-vba-write-excel-data-to-text-file/
Sub WriteTextFile()
Dim rng As Range, lRow As Long
Dim stOutput As String, stNextLine As String, stSeparator As String
Dim stFilename As String, stEncoding As String
Dim fso As Object
'-------------------------------------------------------------------------------------
'CHANGE THESE PARAMETERS TO SUIT
Set rng = ActiveSheet.UsedRange 'this is the range which will be written to text file
stFilename = "C:\Temp\TextOutput.txt" 'this is the text file path / name
stSeparator = vbTab 'e.g. for comma seperated value, change this to ","
stEncoding = "UTF-8" 'e.g. "UTF-8", "ASCII"
'-------------------------------------------------------------------------------------
For lRow = 1 To rng.Rows.Count
If rng.Columns.Count = 1 Then
stNextLine = rng.Rows(lRow).Value
Else
stNextLine = Join$(Application.Transpose(Application.Transpose(rng.Rows(lRow).Value)), stSeparator)
End If
If stOutput = "" Then
stOutput = stNextLine
Else
stOutput = stOutput & vbCrLf & stNextLine
End If
Next lRow
Set fso = CreateObject("ADODB.Stream")
With fso
.Type = 2
.Charset = stEncoding
.Open
.WriteText stOutput
.SaveToFile stFilename, 2
End With
Set fso = Nothing
End Sub
我确信您可以通过工作表来调整它,并输出每个工作表的UsedRange。
修改强>
以下是如何调整它以使用tilde作为分隔符,并循环遍历每个工作表;
Sub OutputAllSheetsTildeSeparated()
Dim rng As Range, lRow As Long
Dim stOutput As String, stNextLine As String, stSeparator As String
Dim stFilepath As String, stFilename As String, stEncoding As String
Dim ws As Worksheet
Dim fso As Object
stFilepath = ThisWorkbook.Path & "\" & Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - 4)
stSeparator = "~"
stEncoding = "UTF-8"
If Dir(stFilepath, vbDirectory) = vbNullString Then MkDir stFilepath
For Each ws In ThisWorkbook.Worksheets
Set rng = ws.UsedRange
stFilename = stFilepath & "\PO" & ws.Name & ".txt"
For lRow = 1 To rng.Rows.Count
If rng.Columns.Count = 1 Then
stNextLine = rng.Rows(lRow).Value
Else
stNextLine = Join$(Application.Transpose(Application.Transpose(rng.Rows(lRow).Value)), stSeparator)
End If
If stOutput = "" Then
stOutput = stNextLine
Else
stOutput = stOutput & vbCrLf & stNextLine
End If
Next lRow
Set fso = CreateObject("ADODB.Stream")
With fso
.Type = 2
.Charset = stEncoding
.Open
.WriteText stOutput
.SaveToFile stFilename, 2
End With
Set fso = Nothing
Next ws
End Sub