Question

有人请帮助我。我进入while循环时遇到错误。请参阅下面的代码。（第一个文件正确运行。当它进入循环错误时将生成）

ActiveSheet.Range("A:E").AutoFilter Field:=1, Criteria1:= _
        "=*CHASE RETURN DATE*", Operator:=xlAnd

完整代码如下：

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 = "|"

    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:=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:=xlAnd
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))

    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:=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(2, 0).Row
ActiveSheet.Paste Destination:=Worksheets("Sheet1").Range(Cells(erow, 1), Cells(erow, 4))
Workbooks(Worksheets(x)).Activate
Selection.AutoFilter
ActiveSheet.Range("A:E").AutoFilter Field:=1, Criteria1:= _
        "=*CHASE RETURN DATE*", Operator:=xlAnd ' This is where I'm getting error as "Type missmatch"
        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

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

wkbAll.Worksheets(x).Activate

在while循环中键入mismatch错误

1 个答案: