2015-09-07 63 views
0

Files Attached我有一个文本文件的列表,我将数据导入到每个选项卡中的新excel文件根据导入的文件。 (比如20个文本文件= 20个选项卡) 1.第一个选项卡将根据我的要求定界数据 2.然后它将根据我的第一条标准进行过滤并将数据粘贴到指定的文件中。 3.它会再次过滤第二个标准并以相同的方式粘贴。 4.第一个选项卡它将正确运行类型不匹配错误在过滤器excel vba

现在我复制了剩余的选项卡(使用while)但是,第一条件将正确运行,但第二条件我得到的错误为“类型不匹配” 我都给予了很大的空间和评论,其中我得到错误

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 

“下面的代码,我发现了错误的类型不匹配

ActiveSheet.Range(‘A:E’)。 AutoFilter Field:= 1,Criteria1:= _ “= CHASE RETURN DATE“,运营商:= 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 
+0

为什么在不使用数组时使用'xlFilterValues'运算符?只需将其删除即可获得简单的值过滤器。 – Rory

+0

同样的错误我得到:( –

+0

我忘了在激活工作表之前忘记添加变量wkbAll对不起我的错误 wkbAll.Worksheets(x).Activate –

回答

0

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

wkbAll.Worksheets(x).Activate 
0

哪条线提高了错误?请执行以下操作以了解:

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

添加resumeResume 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") 

我怀疑范围需要有一个片参考添加到它。

同样

Cells.select 

当代码有行像上面执行不符合该单元格或区域指的是纸,你必须考虑到活动工作表是什么。

从您的描述来看,我并不完全理解您希望自己的代码执行什么操作,但是我怀疑上述代码行导致问题,因为它们看起来有点可疑。

+0

我同意他引用的方式不正确,但'.Paste'部分是关于'Workbook'“Test.xlsm”和'Worksheet'“Sheet1”的,因此你关于'ActiveSheet'为'Test.xlsm'的观点是不正确的,因为它不是'Sheet',而是'Workbook' – DragonSamu

+0

如果'Sheets(“Sheet1”)'引用与Sheet1相同的工作表,Sheet1是工作簿中带有代码的Sheet1代码名表的引用,那么工作簿“ test.xlm“的代码是问题(它可能是,我可能是错误的,但只是要清楚。)我仍然想知道哪一行失败,再次读取代码之前.. – HarveyFrench

+0

请见第二部分o,这可能有助于更多。 – HarveyFrench