[已解决]高级筛选的问题

zwb86 · 发表于 2013-4-21 13:50

这是我自己编写的宏，目的是利用高级筛选筛选出符合出我的条件的零件，但是每当运行到
Set rng = Sheets("条件表").Range(Cells(1, i), Cells(FR, i)).CurrentRegion这句时候总是显示出应用程序错误或者对象定义错误
自己试着改了几次  总是这样  请各位帮忙看看到底是啥问题
option Explicit
Option Base 1
Sub 高级筛选()
Dim FR%, sheetname(), i%, rng As Range, ws As Worksheet
sheetname = Array("发动机", "变速箱", "动力转向油泵", "离合器从动盘", "风扇法兰", "风扇")
For i = 1 To UBound(sheetname)
Sheets.Add after:=Sheets((Sheets.Count))
Set ws = ActiveSheet
ws.Name = sheetname(i)
FR = Sheets("条件表").Cells(65536, i).End(xlUp).Row
Set rng = Sheets("条件表").Range(Cells(1, i), Cells(FR, i)).CurrentRegion
Sheets("精简版").Columns("A:H").AdvancedFilter Action:=xlFilterCopy, _
      CriteriaRange:=rng, _
      CopyToRange:=Sheets(sheetname(i)).Range("A1"), Unique:=False
      Set rng = Nothing
Next i
End Sub

最佳答案

月排行榜 / 总排行榜

爱疯

2013-4-21 14:11

Sub 高级筛选()
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Dim rng As Range
Dim x(), r%, i%
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Call test
x = Array("发动机", "变速箱", "动力转向油泵", "离合器从动盘", "风扇法兰", "风扇")
Set sh2 = Sheets("条件表")
For i = 1 To UBound(x)
Set sh1 = Sheets.Add(after:=Sheets((Sheets.Count)))
sh1.Name = x(i)
r = sh2.Cells(65536, i).End(xlUp).Row
Set rng = sh2.Range(sh2.Cells(1, i), sh2.Cells(r, i))
Sheets("精简版").Columns("A:H").AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=rng, CopyToRange:=sh1.Range("A1")
Set rng = Nothing
Next i
End Sub
Sub test()
Dim sh As Worksheet
For Each sh In Worksheets
If sh.Name <> "精简版" And sh.Name <> "条件表" Then sh.Delete
Next sh
End Sub

复制代码

20 22数据b.rar (134.15 KB, 下载次数: 29)

爱疯 · 发表于 2013-4-21 14:11

Sub 高级筛选()
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Dim rng As Range
Dim x(), r%, i%
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Call test
x = Array("发动机", "变速箱", "动力转向油泵", "离合器从动盘", "风扇法兰", "风扇")
Set sh2 = Sheets("条件表")
For i = 1 To UBound(x)
Set sh1 = Sheets.Add(after:=Sheets((Sheets.Count)))
sh1.Name = x(i)
r = sh2.Cells(65536, i).End(xlUp).Row
Set rng = sh2.Range(sh2.Cells(1, i), sh2.Cells(r, i))
Sheets("精简版").Columns("A:H").AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=rng, CopyToRange:=sh1.Range("A1")
Set rng = Nothing
Next i
End Sub
Sub test()
Dim sh As Worksheet
For Each sh In Worksheets
If sh.Name <> "精简版" And sh.Name <> "条件表" Then sh.Delete
Next sh
End Sub

复制代码

20 22数据b.rar (134.15 KB, 下载次数: 29)

zwb86 · 发表于 2013-4-21 16:20

爱疯发表于 2013-4-21 14:11

能否请教一下这是什么问题导致的么？新手初学请详解麻烦了{:021:}

zwb86 · 发表于 2013-4-21 16:34

爱疯发表于 2013-4-21 14:11

{:011:}还有请问是否可以利用数组存储条件表那个sheet页里边的东西然后用时候再写入rng变量里呢如果可以应当怎样改写代码呢？

爱疯 · 发表于 2013-4-21 22:27

zwb86 发表于 2013-4-21 16:20
能否请教一下这是什么问题导致的么？新手初学请详解麻烦了

原来：Set rng = Sheets("条件表").Range(Cells(1, i), Cells(FR, i)).CurrentRegion
现在：Set rng = sh2.Range(sh2.Cells(1, i), sh2.Cells(r, i))

因为括号里面你没有注明是哪个工作表，所以默认就当作刚刚新增加的工作表（ ActiveSheet，也就是1楼里的ws）

爱疯 · 发表于 2013-4-21 22:36

zwb86 发表于 2013-4-21 16:34
还有请问是否可以利用数组存储条件表那个sheet页里边的东西然后用时候再写入rng变量里呢如果可 ...

Sub 高级筛选()
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Dim rng As Range
Dim x(), r%, i%
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Call test
x = Array("发动机", "变速箱", "动力转向油泵", "离合器从动盘", "风扇法兰", "风扇")
Set sh2 = Sheets("条件表")
For i = 1 To UBound(x)
      Set sh1 = Sheets.Add(after:=Sheets((Sheets.Count)))
      sh1.Name = x(i)
      r = sh2.Cells(65536, i).End(xlUp).Row
      Set rng = sh2.Range(sh2.Cells(1, i), sh2.Cells(r, i))


      Dim arr(1 To 1)
      arr(1) = rng
      Sheets("精简版").Columns("A:H").AdvancedFilter Action:=xlFilterCopy, _
                                                CriteriaRange:=arr(1), CopyToRange:=sh1.Range("A1")
      Set rng = Nothing
Next i
End Sub
Sub test()
Dim sh As Worksheet
For Each sh In Worksheets
      If sh.Name <> "精简版" And sh.Name <> "条件表" Then sh.Delete
Next sh
End Sub

-------------------------------------------------------------------------------
语法
表达式.AdvancedFilter(Action, CriteriaRange, CopyToRange, Unique)
表达式一个代表 Range 对象的变量。
参数
名称必选/可选数据类型说明
Action 必选 XlFilterAction XlFilterAction 的常量之一，用于指定是否就地复制或筛选列表。
CriteriaRange 可选 Variant 条件区域。如果省略该参数，则没有条件限制。
CopyToRange 可选 Variant 如果 Action 为 xlFilterCopy，则为复制行的目标区域。否则，忽略该参数。
Unique 可选 Variant 如果为 True，则只筛选唯一记录。如果为 False，则筛选符合条件的所有记录。默认值为 False。

虽然类型说以选择Variant，但从测试结果看，条件区域必须是单元格区域。

xhrys · 发表于 2013-9-13 11:08

最近在学习高级筛选，不过没见过用VBA来作高级筛选的，真是大开眼界啊

		自动登录	找回密码
密码			注册