Excel VBA,从数组写入列表对象,包括被过滤器隐藏的单元格
Excel VBA, Writing from array to list object, including cells hidden by filters
我在 Excel 2013 年工作,在 VBA 中编写了一个宏,我正在尝试为列表对象的列中的所有单元格分配一个值(table),包括一些可能被过滤器隐藏的内容。单独为每个单元格分配一个值似乎大大减慢了这个过程,我发现了一个建议,将范围复制到一个变体数组中,遍历数组以更改值,然后将数组复制回范围。
varray = table.DataBodyRange.Columns(columnIndex).Value
For i = 1 to UBound(varray, 1)
If (condition) then
varray(i, 1) = i
End If
Next i
table.DataBodyRange.Columns(columnIndex).Value = varray
在大多数情况下,这可以解决速度问题。当 table 中的任何列上有过滤器时,它将停止工作。据我所知,该数组仍会从 table 正确复制,但不会正确复制回来。过滤器隐藏的第一个单元格之前的所有单元格都将被正确处理,但隐藏的单元格不会更改,隐藏单元格之后的任何单元格都将设置为数组中的第一个值。
这仅在单元格被筛选器隐藏时发生,而不是在工作表的行被隐藏时发生。
有谁知道为什么会这样?尽管有过滤器,有没有办法正确地重新应用阵列?如果没有,是否有办法暂时移除过滤器,进行更改,然后将相同的过滤器放回原位?或者只是一种不牺牲速度的更好方法?
如有任何帮助,我们将不胜感激。谢谢!
我在另一个 post here 上找到了捕获自动过滤状态的代码。
Sub ReDoAutoFilter()
Dim w As Worksheet
Dim filterArray()
Dim currentFiltRange As String
Dim col As Integer
Set w = ActiveSheet
' Capture AutoFilter settings
With w.AutoFilter
currentFiltRange = .Range.Address
With .Filters
ReDim filterArray(1 To .Count, 1 To 3)
For f = 1 To .Count
With .Item(f)
If .On Then
filterArray(f, 1) = .Criteria1
If .Operator Then
filterArray(f, 2) = .Operator
filterArray(f, 3) = .Criteria2 'simply delete this line to make it work in Excel 2010
End If
End If
End With
Next f
End With
End With
'Remove AutoFilter
w.AutoFilterMode = False
' Your code here
' Restore Filter settings
For col = 1 To UBound(filterArray(), 1)
If Not IsEmpty(filterArray(col, 1)) Then
If filterArray(col, 2) Then
w.Range(currentFiltRange).AutoFilter field:=col, _
Criteria1:=filterArray(col, 1), _
Operator:=filterArray(col, 2), _
Criteria2:=filterArray(col, 3)
Else
w.Range(currentFiltRange).AutoFilter field:=col, _
Criteria1:=filterArray(col, 1)
End If
End If
Next col
End Sub
一个已知问题是它无法找到一种方法来捕获日期过滤器,其中条件基于从“过滤器”下拉列表中的“树视图”控件中进行的选择。
我在 Excel 2013 年工作,在 VBA 中编写了一个宏,我正在尝试为列表对象的列中的所有单元格分配一个值(table),包括一些可能被过滤器隐藏的内容。单独为每个单元格分配一个值似乎大大减慢了这个过程,我发现了一个建议,将范围复制到一个变体数组中,遍历数组以更改值,然后将数组复制回范围。
varray = table.DataBodyRange.Columns(columnIndex).Value
For i = 1 to UBound(varray, 1)
If (condition) then
varray(i, 1) = i
End If
Next i
table.DataBodyRange.Columns(columnIndex).Value = varray
在大多数情况下,这可以解决速度问题。当 table 中的任何列上有过滤器时,它将停止工作。据我所知,该数组仍会从 table 正确复制,但不会正确复制回来。过滤器隐藏的第一个单元格之前的所有单元格都将被正确处理,但隐藏的单元格不会更改,隐藏单元格之后的任何单元格都将设置为数组中的第一个值。
这仅在单元格被筛选器隐藏时发生,而不是在工作表的行被隐藏时发生。
有谁知道为什么会这样?尽管有过滤器,有没有办法正确地重新应用阵列?如果没有,是否有办法暂时移除过滤器,进行更改,然后将相同的过滤器放回原位?或者只是一种不牺牲速度的更好方法?
如有任何帮助,我们将不胜感激。谢谢!
我在另一个 post here 上找到了捕获自动过滤状态的代码。
Sub ReDoAutoFilter()
Dim w As Worksheet
Dim filterArray()
Dim currentFiltRange As String
Dim col As Integer
Set w = ActiveSheet
' Capture AutoFilter settings
With w.AutoFilter
currentFiltRange = .Range.Address
With .Filters
ReDim filterArray(1 To .Count, 1 To 3)
For f = 1 To .Count
With .Item(f)
If .On Then
filterArray(f, 1) = .Criteria1
If .Operator Then
filterArray(f, 2) = .Operator
filterArray(f, 3) = .Criteria2 'simply delete this line to make it work in Excel 2010
End If
End If
End With
Next f
End With
End With
'Remove AutoFilter
w.AutoFilterMode = False
' Your code here
' Restore Filter settings
For col = 1 To UBound(filterArray(), 1)
If Not IsEmpty(filterArray(col, 1)) Then
If filterArray(col, 2) Then
w.Range(currentFiltRange).AutoFilter field:=col, _
Criteria1:=filterArray(col, 1), _
Operator:=filterArray(col, 2), _
Criteria2:=filterArray(col, 3)
Else
w.Range(currentFiltRange).AutoFilter field:=col, _
Criteria1:=filterArray(col, 1)
End If
End If
Next col
End Sub
一个已知问题是它无法找到一种方法来捕获日期过滤器,其中条件基于从“过滤器”下拉列表中的“树视图”控件中进行的选择。