Question

如何用EXCEL VBA读入固定格式的TXT文档

我现在有一个TXT文档，里面的文本有固定格式，如下图所示。现在想用VBA导入到EXCEL中，并实现如图中所示的格式。
另外，在VBA中还想实现读入两个TXT文档，并根据位置序号进行比较，看两个文档中同一项目编码下的位置序号是否有变动，并显示结果。

Answer 1

写一个示例吧：
你依据着改：
With ActiveSheet.QueryTables.Add(Connection:="TEXT;C:\infor.txt", _
Destination:=Range("A1"))
.Name = "infor_2"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 936
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierSingleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With

Answer 2

可以录制一段宏，导入一个文本文件，会产生如上的代码：
Workbooks.OpenText Filename:=ThisWorkbook.Path & "\" & sTemp, Origin _
:=936, StartRow:=1, DataType:=xlFixedWidth, FieldInfo:=Array( _
Array(0, 2), Array(22, 2), Array(39, 2), Array(50, 2), Array(51, 2), Array(52, 2), Array(60 _
, 2), Array(80, 2), Array(92, 2), Array(143, 2), Array(149, 2), Array(157, 2), Array(216, 2) _
, Array(222, 2), Array(225, 2), Array(254, 2), Array(255, 2), Array(263, 2)), _
TrailingMinusNumbers:=True

然后用如下语句去循环导入所有的文本文件，导入后可以再用其它控制语句去处理：
Set Fso = New FileSystemObject
Set aFolder = Fso.GetFolder(ThisWorkbook.Path)
For Each aFile In aFolder.Files
... ...
... ...
next

Answer 3

参考下：
Sub ReadFile()
Dim dDate As Date
Dim sCustomer As String
Dim sProduct As String
Dim dPrice As Double
Dim sFName As String
Dim iFNumber As Integer 'File number
Dim lRow As Long 'Row number in worksheet
sFName = "C:\VBA_Prog_Ref\Chapter12\JanSales.txt"
'获得未被使用的文件号
iFNumber = FreeFile
'打开文件准备输入
Open sFName For Input As #iFNumber
Sheet2.Cells.Clear ‘清除表格内容
lRow = 2
Do
'从txt 文件读取内容到Excel
Input #iFNumber, dDate, sCustomer, sProduct, dPrice
With Sheet2
.Cells(lRow, 1) = dDate
.Cells(lRow, 2) = sCustomer
.Cells(lRow, 3) = sProduct
.Cells(lRow, 4) = dPrice
End With
'移动到下一行
lRow = lRow + 1
'读取文件，直到文件结尾
Loop Until EOF(iFNumber)
'关闭文件
Close #iFNumber
End Sub