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
为什么在不使用数组时使用'xlFilterValues'运算符?只需将其删除即可获得简单的值过滤器。 – Rory
同样的错误我得到:( –
我忘了在激活工作表之前忘记添加变量wkbAll对不起我的错误 wkbAll.Worksheets(x).Activate –