要从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