时间戳

首页 > 解决方案 > .txt 用于分隔工作表

vba - .txt 用于分隔工作表

问题描述

我正在尝试使用以下代码将多个 .txt 导入工作簿中单独的单独工作表中。在所有工作表中，它都无法用空格分隔最后一行，并且从工作表 2 开始，它也无法复制 .txt 文件的第一行。所有的.txt。文件格式完全相同。任何帮助表示赞赏。

Sub CombineTextFiles()
    Dim FilesToOpen
    Dim x As Integer
    Dim wkbAll As Workbook
    Dim wkbTemp As Workbook
    Dim sDelimiter As String

    On Error GoTo ErrHandler
    Application.ScreenUpdating = False

    FilesToOpen = Application.GetOpenFilename _
      (FileFilter:="Text Files (*.txt), *.txt", _
      MultiSelect:=True, Title:="Text Files to Open")

    If TypeName(FilesToOpen) = "Boolean" Then
        MsgBox "No Files were selected"
        GoTo ExitHandler
    End If

    x = 1
    Set wkbTemp = Workbooks.Open(Filename:=FilesToOpen(x))
    wkbTemp.Sheets(1).Copy
    Set wkbAll = ActiveWorkbook
    wkbTemp.Close (False)
    wkbAll.Worksheets(x).Columns("A:A").TextToColumns _
      Destination:=Range("A1"), DataType:=xlDelimited, TextQualifier:= _
        xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, Semicolon:=False, _
        Comma:=False, Space:=True, Other:=False, OtherChar:="|"

        Dim lastrowA As Long
        Dim lastrowB As Long
        Dim sheetname As String

        With ActiveSheet
            lastrowA = .Cells(.Rows.Count, "A").End(xlUp).Row
            lastrowB = .Cells(.Rows.Count, "B").End(xlUp).Row
            sheetname = ActiveSheet.Name
            Range("a1").EntireColumn.Insert
            Range("a1").Value = sheetname
            Range("a2" & ":a" & lastrowB).Value = Range("a1")
            Range("a1").EntireRow.Insert
        End With


    x = x + 1

    While x <= UBound(FilesToOpen)
        Set wkbTemp = Workbooks.Open(Filename:=FilesToOpen(x))
        With wkbAll
            wkbTemp.Sheets(1).Move After:=.Sheets(.Sheets.Count)
            .Worksheets(x).Columns("A:A").TextToColumns _
              Destination:=Range("A1"), DataType:=xlDelimited, TextQualifier:= _
        xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, Semicolon:=False, _
        Comma:=False, Space:=True, Other:=False

        End With


    With ActiveSheet
            lastrowA = .Cells(.Rows.Count, "A").End(xlUp).Row
            lastrowB = .Cells(.Rows.Count, "B").End(xlUp).Row
            sheetname = ActiveSheet.Name
            Range("a1").Value = sheetname
            Range("a2" & ":a" & lastrowB).Value = Range("a1")
            Range("a1").EntireRow.Insert
    End With

        x = x + 1

    Wend

ExitHandler:
    Application.ScreenUpdating = True
    Set wkbAll = Nothing
    Set wkbTemp = Nothing
    Exit Sub

ErrHandler:
    MsgBox Err.Description
    Resume ExitHandler



End Sub

标签： vbatextimport

解决方案

如果你做一个最小的、完整的、可验证的例子，你可能会自己发现错误。但是，根据您对第一行的描述，我想问题出在这里：

With ActiveSheet
    lastrowA = .Cells(.Rows.Count, "A").End(xlUp).Row
    lastrowB = .Cells(.Rows.Count, "B").End(xlUp).Row
    sheetname = ActiveSheet.Name
    Range("a1").EntireColumn.Insert
    Range("a1").Value = sheetname
    Range("a2" & ":a" & lastrowB).Value = Range("a1")
    Range("a1").EntireRow.Insert
End With

您需要像这样声明范围：

With ActiveSheet
    lastrowA = .Cells(.Rows.Count, "A").End(xlUp).Row
    lastrowB = .Cells(.Rows.Count, "B").End(xlUp).Row
    sheetname = ActiveSheet.Name
    .Range("a1").EntireColumn.Insert
    .Range("a1").Value = sheetname
    .Range("a2" & ":a" & lastrowB).Value = .Range("a1")
    .Range("a1").EntireRow.Insert
End With

看看这些点，它们会有所作为。如果代码位于工作表中，则范围会将它们所在的工作表作为父工作表。

推荐阅读