简体   繁体   English

将Excel工作表导出到文本文件

[英]Export an Excel sheet to a text file

I'm trying to export an Excel page to a .txt file. 我正在尝试将Excel页面导出到.txt文件。 Row one has a header. 第一行有一个标题。 This is not being exported, but I need to do. 这没有被导出,但是我需要这样做。

Here is my code so far. 到目前为止,这是我的代码。 It does everything I need but include the row of column headers, such as Name, Address, Age, etc. 它完成了我需要的一切,但包括了行列标题,例如名称,地址,年龄等。

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' ExportToTextFile
' This exports a sheet or range to a text file, using a
' user-defined separator character.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Sub ExportToTextFile(FName As String, _
    Sep As String, SelectionOnly As Boolean, _
    AppendData As Boolean)

    Dim WholeLine As String
    Dim FNum As Integer
    Dim RowNdx As Long
    Dim ColNdx As Integer
    Dim StartRow As Long
    Dim EndRow As Long
    Dim StartCol As Integer
    Dim EndCol As Integer
    Dim CellValue As String

    Sheets("Export").Visible = True
    Sheets("Export").Select

    Dim Firstrow As Long
    Dim Lastrow As Long
    Dim Lrow As Long
    Dim CalcMode As Long
    Dim ViewMode As Long

    With Application
        CalcMode = .Calculation
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
    End With

    'We use the ActiveSheet but you can replace this with
    'Sheets("MySheet")if you want
     With ActiveSheet

         'We select the sheet so we can change the window view
         .Select

         'If you are in Page Break Preview Or Page Layout view go
         'back to normal view, we do this for speed
         ViewMode = ActiveWindow.View
         ActiveWindow.View = xlNormalView

         'Turn off Page Breaks, we do this for speed
         .DisplayPageBreaks = False

         'Set the first and last row to loop through
         Firstrow = .UsedRange.Cells(1).Row
         Lastrow = .UsedRange.Rows(.UsedRange.Rows.Count).Row

         'We loop from Lastrow to Firstrow (bottom to top)
         For Lrow = Lastrow To Firstrow Step -1

             'We check the values in the A column in this example
             With .Cells(Lrow, "A")

                 If Not IsError(.Value) Then

                     If .Value <> "GEN" Then .EntireRow.Delete
                     'This will delete each row with the Value "ron"
                     'in Column A, case sensitive.

                 End If

             End With

         Next Lrow

     End With

     ActiveWindow.View = ViewMode
     With Application
         .ScreenUpdating = True
         .Calculation = CalcMode
     End With

     Application.ScreenUpdating = False
     On Error GoTo EndMacro:
     FNum = FreeFile

     If SelectionOnly = True Then
         With Selection
             StartRow = .Cells(1).Row
             StartCol = .Cells(1).Column
             EndRow = .Cells(.Cells.Count).Row
             EndCol = .Cells(.Cells.Count).Column
         End With
     Else
         With ActiveSheet.UsedRange
             StartRow = .Cells(1).Row
             StartCol = .Cells(1).Column
             EndRow = .Cells(.Cells.Count).Row
             EndCol = .Cells(.Cells.Count).Column
         End With
     End If

     If AppendData = True Then
         Open FName For Append Access Write As #FNum
     Else
         Open FName For Output Access Write As #FNum
     End If

     For RowNdx = StartRow To EndRow
         WholeLine = ""
         For ColNdx = StartCol To EndCol
             If Cells(RowNdx, ColNdx).Value = "" Then
                 CellValue = ""
             Else
                 CellValue = Cells(RowNdx, ColNdx).Value
             End If
             WholeLine = WholeLine & CellValue & Sep
         Next ColNdx
         WholeLine = Left(WholeLine, Len(WholeLine) - Len(Sep))
         Print #FNum, WholeLine
     Next RowNdx

 EndMacro:
     On Error GoTo 0
     Application.ScreenUpdating = True
     Close #FNum

 End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' END ExportTextFile
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' DoTheExport
' This prompts the user for the FileName and the separtor
' character and then calls the ExportToTextFile procedure.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub DoTheExport()
    Dim FileName As Variant
    Dim Sep As String
    FileName = Application.GetSaveAsFilename(InitialFileName:=vbNullString,           FileFilter:="Text Files (*.txt),*.txt")
    If FileName = False Then
        ''''''''''''''''''''''''''
        ' user cancelled, get out
        ''''''''''''''''''''''''''
        Exit Sub
    End If
    Sep = "|"
    Debug.Print "FileName: " & FileName, "Separator: " & Sep
    ExportToTextFile FName:=CStr(FileName), Sep:=CStr(Sep), _
    SelectionOnly:=False, AppendData:=True

    Sheets("Export").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.AutoFill Destination:=Range("A1:M500")
    Range("A1:M500").Select
    Range("A1").Select
    ActiveWindow.SelectedSheets.Visible = False

End Sub

Perhaps you are deleting the headings row because "Name" <> "GEN" 也许您正在删除标题行,因为“名称” <>“ GEN”

If .Value = "ron" Then .EntireRow.Delete
     'This will delete each row with the Value "ron"
     'in Column A, case sensitive.

声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM