如何通过Excel宏读取TXT文件并拆分TCD数据至不同工作表？

每日需分析100个TXT文件，希望通过Excel宏实现：

• 将每个TXT中的TCD1数据导入第一个工作表，TCD2数据导入第二个工作表
• 仅提取指定时间范围内的time及对应的area数据
  目前使用现有宏读取TXT时持续报错，需修改代码满足需求。

原代码：

Sub Import()
'
' Import Macro
'

    Columns("A:H").Select
    Selection.ClearContents
    
    Columns("X").Select
    Selection.ClearContents

' The spaces in dirname between stored. and Example are for looks
    dirname = InputBox("Input the Directory where GC Data is stored.          Example: X:\Data\GC\Backup\DATA\", _
                       "Location 1", "C:\Users\Malek\Desktop\DWF JSS\RUN JSS-GQMULT- 101413 2013-10-28 16-36-31")
   j = InputBox("Input the total number of files to import", "Here we go!", 3)
 
   s = 130
   
Application.ScreenUpdating = False
 Application.Calculation = xlCalculationManual


For i = 1 To j
If i < 10 Then
Filename = "001F0"
ElseIf i < 100 Then
Filename = "001F"
Else
Filename = "001F"
End If
    

N = (s * (i)) + 3

    With ActiveSheet.QueryTables.Add(Connection:= _
       "TEXT;" & dirname & "\" & Filename & i & "01" & ".D\Report.TXT" _
        , Destination:=Cells(N, 1))
        .Name = "Report"
        .FieldNames = True
        .RowNumbers = 1
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 1252
        .TextFileStartRow = 22
        .TextFileParseType = xlFixedWidth
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1)
        .TextFileFixedColumnWidths = Array(5, 8, 6, 7, 11, 11, 9)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
Cells((s * (i)) + 3, 24).Value = i
Next i

i = i - 1
Cells((s * (i)) + 3 + s, 24).Value = "END"

Application.ScreenUpdating = True
 Application.Calculation = xlCalculationAutomatic

'

'
End Sub

核心修改点 #

• 明确指定TCD1/TCD2对应的工作表，避免ActiveSheet的不确定性
• 改用逐行读取TXT文件的方式，精准识别TCD数据区块，同时筛选时间范围
• 修复文件名拼接逻辑，避免路径错误导致的读取报错
• 添加时间范围输入，让用户自定义需要提取的时间段
• 仅提取time和area列，减少冗余数据

修改后的完整代码 #

Sub ImportTCDData()
    Dim wsTCD1 As Worksheet, wsTCD2 As Worksheet
    Dim dirname As String, totalFiles As Integer
    Dim startTime As Double, endTime As Double
    Dim i As Integer, fileNamePrefix As String
    Dim fullPath As String, fileNum As Integer
    Dim lineText As String, currentTCD As String
    Dim lastRowTCD1 As Long, lastRowTCD2 As Long
    Dim timeVal As Double, areaVal As Double
    
    ' 初始化工作表
    Set wsTCD1 = ThisWorkbook.Worksheets(1)
    Set wsTCD2 = ThisWorkbook.Worksheets(2)
    ' 清空目标工作表数据
    wsTCD1.UsedRange.ClearContents
    wsTCD2.UsedRange.ClearContents
    ' 写入表头
    wsTCD1.Range("A1:B1") = Array("Time", "Area")
    wsTCD2.Range("A1:B1") = Array("Time", "Area")
    
    ' 获取用户输入
    dirname = InputBox("输入GC数据存储目录，示例：X:\Data\GC\Backup\DATA\", "目录路径")
    If dirname = "" Then Exit Sub
    totalFiles = InputBox("输入要导入的文件总数", "文件数量", 100)
    If totalFiles <= 0 Then Exit Sub
    startTime = Val(InputBox("输入起始时间（数值格式，如1.5）", "起始时间"))
    endTime = Val(InputBox("输入结束时间（数值格式，如10.0）", "结束时间"))
    If startTime >= endTime Then Exit Sub
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    ' 遍历所有文件
    For i = 1 To totalFiles
        ' 生成文件名前缀
        Select Case i
            Case 1 To 9
                fileNamePrefix = "001F0" & i
            Case 10 To 99
                fileNamePrefix = "001F" & i
            Case 100
                fileNamePrefix = "001F" & i
        End Select
        ' 拼接完整文件路径
        fullPath = dirname & "\" & fileNamePrefix & "01.D\Report.TXT"
        
        ' 检查文件是否存在
        If Dir(fullPath) = "" Then
            MsgBox "文件不存在：" & fullPath, vbExclamation
            GoTo NextFile
        End If
        
        ' 打开TXT文件
        fileNum = FreeFile()
        Open fullPath For Input As #fileNum
        
        currentTCD = ""
        lastRowTCD1 = wsTCD1.Cells(wsTCD1.Rows.Count, "A").End(xlUp).Row
        lastRowTCD2 = wsTCD2.Cells(wsTCD2.Rows.Count, "A").End(xlUp).Row
        
        ' 逐行读取数据
        Do Until EOF(fileNum)
            Line Input #fileNum, lineText
            lineText = Trim(lineText)
            
            ' 识别TCD区块标记（需根据你的TXT实际格式调整，示例为"TCD1"和"TCD2"）
            If InStr(lineText, "TCD1") > 0 Then
                currentTCD = "TCD1"
                ' 跳过表头行（根据你的TXT实际结构调整行数）
                For Skip = 1 To 3
                    If Not EOF(fileNum) Then Line Input #fileNum, lineText
                Next Skip
            ElseIf InStr(lineText, "TCD2") > 0 Then
                currentTCD = "TCD2"
                For Skip = 1 To 3
                    If Not EOF(fileNum) Then Line Input #fileNum, lineText
                Next Skip
            ElseIf currentTCD <> "" And IsNumeric(Split(lineText, vbTab)(0)) Then
                ' 提取time和area（假设是制表符分隔，第1列是time，第5列是area，需根据实际调整索引）
                timeVal = Val(Split(lineText, vbTab)(0))
                areaVal = Val(Split(lineText, vbTab)(4))
                
                ' 筛选时间范围
                If timeVal >= startTime And timeVal <= endTime Then
                    Select Case currentTCD
                        Case "TCD1"
                            lastRowTCD1 = lastRowTCD1 + 1
                            wsTCD1.Cells(lastRowTCD1, "A").Value = timeVal
                            wsTCD1.Cells(lastRowTCD1, "B").Value = areaVal
                        Case "TCD2"
                            lastRowTCD2 = lastRowTCD2 + 1
                            wsTCD2.Cells(lastRowTCD2, "A").Value = timeVal
                            wsTCD2.Cells(lastRowTCD2, "B").Value = areaVal
                    End Select
                End If
            End If
        Loop
        
        Close #fileNum
NextFile:
    Next i
    
    ' 自动调整列宽
    wsTCD1.Columns("A:B").AutoFit
    wsTCD2.Columns("A:B").AutoFit
    
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    MsgBox "数据导入完成！", vbInformation
End Sub

关键说明 #

1. TCD区块识别：代码中通过InStr(lineText, "TCD1")判断区块，需根据你的TXT文件实际的分隔标记调整（比如你的TXT中可能是"--- TCD1 Data ---"这类格式，要修改对应的判断条件）
2. 列索引调整：Split(lineText, vbTab)(0)和Split(lineText, vbTab)(4)分别对应time和area的列位置，需根据TXT中数据的实际列数调整索引（索引从0开始）
3. 路径验证：添加了文件存在检查，避免因路径错误导致的读取报错
4. 时间格式：假设time是数值格式（如1.23），如果你的time是时间字符串（如"00:01:13"），需修改timeVal的转换逻辑，比如用CDate()转换后再比较

内容的提问来源于stack exchange，提问作者June