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

时间:2014-08-02 13:54:58

标签: excel excel-vba vba

我正在尝试将Excel页面导出到.txt文件。第一行有一个标题。这不是出口,但我需要做。

到目前为止,这是我的代码。它可以完成我需要的所有内容,但包括列标题行,例如名称,地址,年龄等。

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 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

1 个答案:

答案 0 :(得分:0)

也许您正在删除标题行,因为&#34;姓名&#34; &LT;&GT; &#34; GEN&#34;

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