在保留自动过滤器设置的同时清除单元格?

时间:2011-11-29 01:52:48

标签: excel vba excel-vba autofilter

我正在为一个工作表编写脚本,该工作表的单元格是基于Access数据库填充的。我试图清除工作表的内容,而不删除用户设置的任何自动过滤器,然后根据数据库重新加载数据。现在我正在使用:

Sub populateSheet()

Dim sht As Worksheet
Dim db As Database
Dim rs As Recordset


Set db = OpenDatabase("c:\myDB.mdb")
Set rs = db.OpenRecordset("myData")
Set sht = ThisWorkbook.Sheets("my output")
With sht
    .Cells.value=empty
    For c = 0 To rs.Fields.Count - 1
        .Cells(1, c + 1) = rs.Fields(c).name
    Next
    .Range("a2").CopyFromRecordset rs
End With

End Sub

sub buildTable()

dim ws as workspace
dim db as database
dim dbPath as string

set ws=dbengine.workspaces(0)
set db=ws.createdatabase("c:\myDB.mdb")
db.execute "create table myData (field1 text,field2 text)"
db.execute "insert into myData (field1,field2) values (""1"",""a"")"
db.execute "insert into myData (field1,field2) values (""2"",""b"")"
db.execute "insert into myData (field1,field2) values (""3"",""a"")"

db.close

end sub
sub test()
 buildTable
 populateSheet
end sub

当我运行.cells.clear时,它会清除自动过滤器。有没有办法保持自动过滤设置,以便以相同的方式过滤新数据?或者也许记录它们并重新应用相同的设置?我尝试使用this solution,但我无法检测哪些列已被过滤。

编辑:

我在上面的代码中应用了Jean-FrançoisCorbett的方法,但它有一个问题。尝试使用测试表:

1 a
2 b
3 a

运行populateSheet后,自动过滤第二列只包含“a”,工作表显示:

1 a
3 a

然后再次运行populateSheet,工作表现在显示:

1 a
1 a

如果您删除了自动过滤器,请重新运行populateSheet并重新应用自动过滤器,您将获得正确的数据,但这是获得正确输出的非常麻烦的额外步骤。

编辑: 我添加了代码来创建数据库并创建一个可用于测试populateSheet的表,并更改populateSheet中的一些参数以反映此测试数据库。

2 个答案:

答案 0 :(得分:3)

如果您只想清除单元格中的值而不是其他内容,那么您可以这样做:

sht.Cells.Value = Empty

编辑响应OP的编辑:

奇怪的是,上面的语句并没有清空Autofilter隐藏的任何行中的单元格!我认为使用CopyFromRecordset导入数据时,自动过滤隐藏的行也会导致意外行为。

该问题的解决方案当然是在清空所有单元格并导入数据之前,通过将自动过滤器设置为(All)来取消隐藏所有行,这在VBA中是这样做的:

With Range("C1:D1") ' or wherever the filters are
    .AutoFilter Field:=1
    .AutoFilter Field:=2
    ' ... continue to set all fields to (All).
End With

答案 1 :(得分:0)

好的,我有一个解决方案。基本上,我在一系列变体中记录自动过滤器标准,然后删除自动过滤器设置,填充表格(使用@ Jean-FrançoisCorbett建议的sht.Cells.Value = Empty)然后重新应用阵列中的设置。代码如下:

Sub reapplyAutofilter()

Dim fltr As Filter
Dim columnCriteria1() As Variant
Dim columnCriteria2() As Variant
Dim columnOperators() As Variant

Dim filterCriteria() As Variant
Dim sht As Worksheet
Dim rangeAddr As String
Dim fieldCount As Long
Dim ctr As Long



Set sht = ThisWorkbook.Sheets("mySheet")

'don't analyze autofilter if it's not on
If Not sht.AutoFilterMode Then              
    populateSheet
    Exit Sub
End If


'put autofilter settings in arrays for criteria1, criteria2, and operator    
With sht.AutoFilter
    rangeAddr = .Range.Address                 
    fieldCount = .Filters.Count
    ReDim columnCriteria1(1 To fieldCount)
    ReDim columnCriteria2(1 To fieldCount)
    ReDim columnOperators(1 To fieldCount)
    For ctr = 1 To fieldCount
        With .Filters(ctr)
            If .On Then
                columnCriteria1(ctr) = .Criteria1
                columnOperators(ctr) = .Operator
                If (.Operator = xlOr) or (.Operator=xlAnd) Then
                    columnCriteria2(ctr) = .Criteria2
                Else
                    columnCriteria2(ctr) = Null
                End If
            Else
                columnCriteria1(ctr) = Null
            End If
        End With
    Next ctr
End With

'clear autofilter     
sht.AutoFilterMode = False

populateSheet


're-apply autofilter settings    
With sht.Range(rangeAddr)
    For ctr = 1 To fieldCount
        If Not IsNull(columnCriteria1(ctr)) Then
            If IsNull(columnCriteria2(ctr)) Then
                .AutoFilter Field:=ctr, Criteria1:=columnCriteria1(ctr), Operator:=xlFilterValues
            Else
                .AutoFilter Field:=ctr, Criteria1:=columnCriteria1(ctr), Criteria2:=columnCriteria2(ctr), Operator:=columnOperators(ctr)
            End If
        End If
    Next
End With


End Sub

我不确定这是否算我解决问题,因为我受到了Jean-FrançoisCorbett代码的启发。我必须自己弄清楚如何捕获并重新应用Autofilter设置。请随意加入关于谁应该得到这个信用的信息;否则,我会接受我自己的答案。