Excel 导出指定行为txt文件（VBA,宏）

要从Excel 多个sheet内导出指定行为txt文件，懒得用C#了，写个VBA宏

 Sub Export()
     Dim FileName As Variant
     Dim Sep As String
     Dim StartSheet As Integer
     Dim EndSheet As Integer

     Dim ExportIndex As Integer

     '文件名
     FileName = Application.GetSaveAsFilename(InitialFileName:=vbNullString, FileFilter:="Text Files (*.txt),*.txt")
     If FileName = False Then
         ''''''''''''''''''''''''''
         ' user cancelled, get out
         ''''''''''''''''''''''''''
         Exit Sub
     End If
     '分隔符
    ' Sep = Application.InputBox("Enter a separator character.", Type:=2)

     '开始Sheet
     'StartSheet = Application.InputBox("开始Sheet.", Type:=2)
     '结束Sheet
     EndSheet = Application.InputBox("结束Sheet.", Type:=)

     '导出行
     ExportIndex = Application.InputBox("导出行号.", Type:=)

     ShartSheet:=StartSheet, EndSheet:=EndSheet, ExportRow:=ExportIndex
      ExportRangeToTextFile FName:=CStr(FileName), SelectionOnly:=False, AppendData:=False, _
     ShartSheet:=, EndSheet:=EndSheet, ExportRow:=ExportIndex
 End Sub

 ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 ' 将Excel内多个Sheet中的某一行导出Text
 ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 Public Sub ExportRangeToTextFile(FName As String, _
     SelectionOnly As Boolean, _
     AppendData As Boolean, ShartSheet As Integer, _
     EndSheet As Integer, ExportRow As Integer)

 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
 Dim X As Variant

 Application.ScreenUpdating = False
 On Error GoTo EndMacro:
 FNum = FreeFile
  Open FName For Output Access Write As #FNum

 For i =  To Application.sheets.Count
     X = Application.sheets(i).UsedRange.Value
     WholeLine = ""
    With Application.sheets(i).UsedRange
         StartRow = .Cells().Row
         StartCol = .Cells().Column
         EndRow = .Cells(.Cells.Count).Row
         EndCol = .Cells(.Cells.Count).Column
     End With

     For j =  To EndCol
         WholeLine = WholeLine + X(ExportRow, j) + Chr("") '\t
     Next
     Print #FNum, WholeLine
 Next
     MsgBox "OK" '
 EndMacro:
 On Error GoTo
 Application.ScreenUpdating = True
 Close #FNum
 'XT = Application.Transpose(X)转置

 End Sub

 ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 ' 导出单个sheet
 ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 Public Sub ExportSingleSheetToTextFile(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

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

 If SelectionOnly = True Then
     With Selection
         StartRow = .Cells().Row
         StartCol = .Cells().Column
         EndRow = .Cells(.Cells.Count).Row
         EndCol = .Cells(.Cells.Count).Column
     End With
 Else
     With ActiveSheet.UsedRange
         StartRow = .Cells().Row
         StartCol = .Cells().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 = Chr() & Chr()
         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
 Application.ScreenUpdating = True
 Close #FNum

 End Sub

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 将Excel内多个Sheet中的某一行导出New Sheet
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Sub ExportRangeToNewSheet(FName As String, _
    SelectionOnly As Boolean, _
    AppendData As Boolean, ShartSheet As Integer, _
    EndSheet As Integer, ExportRow As Integer)
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
Dim X As Variant
Dim Xsheet As Worksheet

Set Xsheet = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
Xsheet.Name = FName 'Format(Now(), "HHmmss")

Application.ScreenUpdating = False

Dim index As Integer
 index =
'For i = 1 To Application.Sheets.Count
For i = ShartSheet To EndSheet 'Application.Sheets.Count
   With Application.Sheets(i).UsedRange
        EndCol = .Cells(.Cells.Count).Column
    For j =  To EndCol
        Xsheet.Cells(j,  * index - ).Value = .Cells(, j).Text
        Xsheet.Cells(j,  * index).Value = .Cells(ExportRow, j).Text
    Next
    End With
    index = index +
Next
    MsgBox "导出OK，Sheet名" + FName '
'XT = Application.Transpose(X)转置

End Sub

//从text文件导入Excel sheet里面

Sub OpenFile()

 Dim filter As String
    Dim fileToOpen

    filter = "All Files(*.*),*.*,Word Documents(*.do*),*.do*," & _
            "Text Files(*.txt),*.txt"
    fileToOpen = Application.GetOpenFilename(filter, 4, "请选择文件")

    If fileToOpen = False Then
        MsgBox "你没有选择文件", vbOKOnly, "提示"
    Else

     ' Workbooks.Open FileName:=fileToOpen
     '   MsgBox "你选择的文件是：" & fileToOpen, vbOKOnly, "提示"
       With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;" + fileToOpen, Destination:=Range("$A$1") _
        )
        .Name = "Sample"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 437
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = True
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
    End If
End Sub

　　

vba: Importing text file into excel sheet

http://blog.csdn.net/ldwtill/article/details/8571781

Using a QueryTable

Sub Sample()
    With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;C:\Sample.txt", Destination:=Range("$A$1") _
        )
        .Name = "Sample"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 437
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = True
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
End Sub
Open the text file in memory

Sub Sample()
    Dim MyData As String, strData() As String

    Open "C:\Sample.txt" For Binary As #1
    MyData = Space$(LOF(1))
    Get #1, , MyData
    Close #1
    strData() = Split(MyData, vbCrLf)
End Sub
Once you have the data in the array you can export it to the current sheet.

Using the method that you are already using

Sub Sample()
    Dim wbI As Workbook, wbO As Workbook
    Dim wsI As Worksheet

    Set wbI = ThisWorkbook
    Set wsI = wbI.Sheets("Sheet1") '<~~ Sheet where you want to import

    Set wbO = Workbooks.Open("C:\Sample.txt")

    wbO.Sheets(1).Cells.Copy wsI.Cells

    wbO.Close SaveChanges:=False
End Sub
FOLLOWUP

You can use the Application.GetOpenFilename to choose the relevant file. For example...

Sub Sample()
    Dim Ret

    Ret = Application.GetOpenFilename("Prn Files (*.prn), *.prn")

    If Ret <> False Then
        With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;" & Ret, Destination:=Range("$A$1"))

            '~~> Rest of the code

        End With
    End If
End Sub