Question

我正在尝试使用以下代码将多个.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

Answer 1

如果你制作minimal, complete, and verifiable example，你可能会自己发现错误。但是，根据您对第一行的描述，我猜问题就在这里：

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

看点，他们有所不同。如果代码位于工作表中，则范围将其所在的工作表作为父工作表。

.txt分隔工作表

1 个答案: