Question

Files Attached我有一个文本文件列表，我会根据导入的文件将数据导入每个选项卡中的新excel文件。（比如20个文本文件= 20个标签） 1.第一个选项卡将根据我的要求分隔数据 2.然后它将按照我的第一个标准进行过滤，并将数据粘贴到指定的文件中。 3.它将再次过滤第二个标准并以相同的方式粘贴。 4.它将正确运行的第一个标签

现在我复制了其余的标签（使用while）但是，第一个标准将正确运行，但第二个标准我得到的错误是＆＃34;类型不匹配＆＃34; 我给了一个很大的空间和评论，我收到了错误

Option Explicit

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

    On Error GoTo ErrHandler
    Application.ScreenUpdating = False

    sDelimiter = "|"
'Import multiple Text files
    FilesToOpen = Application.GetOpenFilename _
      (FileFilter:="Text Files (*.txt), *.txt", _
      MultiSelect:=True, Title:="Text Files to Open")
'Only if none get selected
    If TypeName(FilesToOpen) = "Boolean" Then
        MsgBox "No Files were selected"
        GoTo ExitHandler
    End If
'Create new tabs to generate one file with delimited
    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:=xlFixedWidth, _
        FieldInfo:=Array(Array(0, 2), Array(47, 2), Array(72, 2), Array(93, 2), Array(103, 2)) _
        , TrailingMinusNumbers:=True
        Cells.Select
        Selection.AutoFilter
        ActiveSheet.Range("A:E").AutoFilter Field:=2, Criteria1:="=*$*", _
        Operator:=xlAnd
        ActiveSheet.UsedRange.Offset(1, 0).SpecialCells(xlCellTypeVisible).Copy
    Workbooks("Test.xlsm").Activate
        Sheets("Sheet1").Select
        erow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
        ActiveSheet.Paste Destination:=Worksheets("Sheet1").Range(Cells(erow, 1), Cells(erow, 4))

'To pick the date
wkbAll.Worksheets(x).Activate
    Selection.AutoFilter
    ActiveSheet.Range("A:E").AutoFilter Field:=1, Criteria1:= _
        "=*CHASE RETURN DATE*", Operator:=xlFilterValues
            With ActiveSheet.UsedRange.Columns(4).Offset(1, 0).Resize(Rows.Count - 1, 1).SpecialCells(xlCellTypeVisible).Select
            End With
            Selection.Copy
 Workbooks("Test.xlsm").Activate
    Sheets("Sheet1").Select
    erow = Sheet1.Cells(Rows.Count, 6).End(xlUp).Offset(1, 0).Row
    ActiveSheet.Paste Destination:=Worksheets("Sheet1").Range(Cells(erow, 6), Cells(erow, 6))

'Sum Amount
wkbAll.Worksheets(x).Activate
    Selection.AutoFilter
    ActiveSheet.Range("A:E").AutoFilter Field:=3, Criteria1:= _
        "=*$*", Operator:=xlAnd
            With ActiveSheet.UsedRange.Columns(3).Offset(1, 0).Resize(Rows.Count - 1, 1).SpecialCells(xlCellTypeVisible).Select
            End With
            Selection.Copy
Workbooks("Test.xlsm").Activate
    Sheets("Sheet1").Select
    erow = Sheet1.Cells(Rows.Count, 2).End(xlUp).Offset(1, 0).Row
    ActiveSheet.Paste Destination:=Worksheets("Sheet1").Range(Cells(erow, 2), Cells(erow, 2))

'Create new tabs to generate rest of the files with delimited, filter, criteria as above
    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:=xlFixedWidth, _
        FieldInfo:=Array(Array(0, 2), Array(47, 2), Array(72, 2), Array(93, 2), Array(103, 2)) _
        , TrailingMinusNumbers:=True
        Cells.Select
    Selection.AutoFilter
    ActiveSheet.Range("A:E").AutoFilter Field:=2, Criteria1:="=*$*", _
        Operator:=xlFilterValues
        ActiveSheet.UsedRange.Offset(1, 0).SpecialCells(xlCellTypeVisible).Copy
Workbooks("Test.xlsm").Activate
    Sheets("Sheet1").Select
    erow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(2, 0).Row
    ActiveSheet.Paste Destination:=Worksheets("Sheet1").Range(Cells(erow, 1), Cells(erow, 4))
'To pick the date
Workbooks(Worksheets(x)).Activate
        Selection.AutoFilter

＆＃39;以下代码我将错误视为类型不匹配

ActiveSheet.Range（＆＃34; A：E＆＃34;）。AutoFilter字段：= 1，Criteria1：= _ ＆＃34; = CHASE RETURN DATE ＆＃34;，运营商：= xlFilterValues

        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

哪一行引发错误？请执行以下操作以查找：

在错误处理程序中的MsgBox行上添加一个断点。

在resume

之后添加Resume ExitHandler

运行代码。

当代码在断点处停止时，将下一个语句移动为“resume”，并通过单步执行启动代码。

将选择引发错误的行。

这看起来不对：

Workbooks("Test.xlsm").Activate
    Sheets("Sheet1").Select
    erow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
    ActiveSheet.Paste Destination:=Worksheets("Sheet1").Range(Cells(erow, 1), Cells(erow, 4))

您正在使用

粘贴到表格中

ActiveSheet.Paste Destination:=Worksheets("Sheet1")

但是后来你用同一行

Cells(erow, 1), Cells(erow, 4))

这是指活动表上的单元格为“Test.xlsm”！

您的代码中还有其他行具有相似的代码。

VBA不会喜欢这个！

让我知道你是怎么过的。

=============================================== ============

第2部分：

Destination:=Range("A1")

我怀疑Range需要添加一个工作表引用。

同样

Cells.select

如果代码中包含上述不符合单元格或范围引用的工作表的行，则必须始终考虑活动工作表的内容。

从您的描述中，我并不完全了解您希望代码执行的操作，但我怀疑上述内容会导致问题，因为它们看起来有点可疑。

Answer 2

我忘了在激活工作表之前将变量添加为wkbAll。对不起我的错误

wkbAll.Worksheets(x).Activate

在过滤器excel vba中键入不匹配错误

2 个答案: