使用 Tab 作为分隔符,并在空行处开始一个新工作表



我有一个脚本可以将文本文件导入Excel。

目标是使用 Tab 作为分隔符,并在空行处开始一个新的工作表。

问题 当前脚本为每行启动一个新工作表。

我是否需要使用其他方法来解释空行?成功解释和处理工作表的其他尝试会更改,在导入时从数据中删除空格,然后使用分隔符无效。

Public Sub ImportTextFile(FName As String, Sep As String)
Dim RowNdx As Long
Dim ColNdx As Integer
Dim TempVal As Variant
Dim WholeLine As String
Dim Pos As Integer
Dim NextPos As Integer
Dim SaveColNdx As Integer
Dim WS As Worksheet
Dim SheetNumber As Long
Const C_START_SHEET_NAME = "Sheet1"
SheetNumber = 1
RowNdx = C_START_ROW_FIRST_PAGE
Set WS = ActiveWorkbook.Worksheets(C_START_SHEET_NAME)
Application.ScreenUpdating = False
SaveColNdx = ActiveCell.Column
RowNdx = ActiveCell.Row
Open FName For Input Access Read As #1
While Not EOF(1)
    Line Input #1, WholeLine
    'This section added to create new sheets for empty lines
    If InputLine = "" Then
           SheetNumber = SheetNumber + 1
           Set WS = ActiveWorkbook.Worksheets.Add(after:=WS)
           RowNdx = 1
    End If
    If Right(WholeLine, 1) <> Sep Then
        WholeLine = WholeLine & Sep
    End If
    ColNdx = SaveColNdx
    Pos = 1
    NextPos = InStr(Pos, WholeLine, Sep)
    While NextPos >= 1
        TempVal = Mid(WholeLine, Pos, NextPos - Pos)
        Cells(RowNdx, ColNdx).Value = TempVal
        Pos = NextPos + 1
        ColNdx = ColNdx + 1
        NextPos = InStr(Pos, WholeLine, Sep)
    Wend
    RowNdx = RowNdx + 1
    SheetNumber = SheetNumber + 1
Wend
EndMacro:
On Error GoTo 0
Application.ScreenUpdating = True
Close #1
End Sub

您正在读取WholeLine,然后测试InputLine

添加Option Explicit会捕获这样的事情。

相关内容

最新更新