将 excel 文件保存为不带分隔符的文本并保留空单元格

Question

我有 excel 表想将其保存为 txt 文件，但没有分隔符，同时保持空单元格的空间在范围内

下面是代码

    Dim WorkRng As Range
Dim xFile As Variant
Dim xFileString As String
On Error Resume Next
xTitleId = "Define Range"
Set WorkRng = Application.Selection
Set WorkRng = Application.InputBox("Range", xTitleId, WorkRng.Address, Type:=8)
Application.ActiveSheet.Copy
Application.ActiveSheet.Cells.Clear
WorkRng.Copy Application.ActiveSheet.Range("A1")
Set xFile = CreateObject("Scripting.FileSystemObject")



xFileString = Application.GetSaveAsFilename("") 'fileFilter:="Comma Separated Text (*.CSV), *.CSV")
Application.ActiveWorkbook.SaveAs Filename:=xFileString & ".txt", FileFormat:=xlText, CreateBackup:=False
End Sub

Answer 1

您可以使用以下代码：

Sub SaveAsText()

    '===============================================================
    '       First get the used range
    '===============================================================
    Dim cells As Range
    Set cells = ActiveSheet.UsedRange
    
    '===============================================================
    '       Now, iterate over all cells and store data
    '===============================================================
    'Open a text file to write data in
    Dim myFile As String
    myFile = ThisWorkbook.Path & "\output.txt"
    
    Open myFile For Output As #1
    
    Dim cell As Range
    Dim row As Integer
    Dim str As String
    row = 1 'used to write each Excel row in a single row in the text file
    For Each cell In cells
        
        'Is it a new row?
        If cell.row <> row Then 'yes
            
            'Write the previous row's values
            Write #1, str
            
            'Update row
            row = row + 1
            
            'Reset str
            str = cell.Value
            
        Else 'no
            
            'Update str
            If IsEmpty(cell) Then
                str = str & " "
            Else
                str = str & cell.Value
            End If
            
            
        End If
        
    Next
    
    'Write the last str
    Write #1, str
    

    'Close the file
    Close #1
    
End Sub

此代码为您的示例生成以下 output：

我已将 output 文件命名为“output.txt”。 你可以随意命名它。

Answer 2

请尝试下一个代码。 它假定在您的图片中看起来为空的单元格中，没有任何空间，它们只是空的：

Sub testSaveAsTextNoDelim()
   Dim fileSaveName As String, fileNam As String, TempNam As String
   Dim fso As Object, txtStr As Object, Fileout As Object, strText As String

   fileNam = "textWithoutDelim.txt" 'the name you want for the txt file
   fileSaveName = Application.GetSaveAsFilename(InitialFileName:=fileNam, _
                                 Filefilter:="Text Files (*.txt), *.txt")

    If fileSaveName <> "" Then
        'create a temporary name for a text file to be processed:
        TempNam = left(fileSaveName, Len(fileSaveName) - 4) & "1.txt"
        ActiveWorkbook.SaveAs fileName:=TempNam, FileFormat:=xlTextMSDOS  'xlTextWindows

        Set fso = CreateObject("Scripting.FileSystemObject")

        Set txtStr = fso.OpenTextFile(TempNam)
            strText = txtStr.ReadAll 'read all the content in a string variable
        txtStr.Close
        strText = Replace(strText, vbTab & vbTab, " ")'replace double Tab with space " "
        strText = Replace(strText, " " & vbTab, "  ") 'replace Tab and " " with double spaces
        strText = Replace(strText, vbTab, "") 'replace all Tabs
        'drop the processed string in the file you need:
        Set Fileout = fso.CreateTextFile(fileSaveName, True, True)
            Fileout.Write strText
        Fileout.Close
        'here you can close the created workbook and Kill the file...
        MsgBox "Saved as " & fileSaveName
    End If
End Sub