VBA选择已过滤单元格 [英] VBA Select Filtered Cells

问题描述

我在工作表中有UserForm。
在这种形式下，我有6个组合框。

这个组合框从一个6列的表格填充，每列都到一个组合框。
选择每个组合框后，我在此工作表中进行过滤，并重新填充下一个。

我将给您一个示例，更清楚。

我有一个6列的表格：

Continent |国家|状态|城市|街|建筑名称

此工作表包含所有这些工具的所有可能组合。
例如：
对于街道中的每个建筑物，我有一行包含所有相同的5个第一项，最后一个项改变。

用户打开我填充第一个组合框与表的第一列的形式（我做一个例程来获得唯一的项目）。
当用户更改第一个组合框时，我将过滤器应用于第一列中的工作表，然后使用过滤后的工作表填充第二个组合框。

我的问题是如何获得过滤的范围。
我这样做：

lastRow = Sheets（SIP）。Range（A65536）。End（xlUp）.Row

lFiltered = Sheets（SIP）。范围（A2：F& lastRow）.SpecialCells（xlCellTypeVisible）.Cells

但是当我应用一个过滤器，它隐藏，例如，只有第10行，lFiltered变量将只返回到第9行。
它打破了第一个隐藏的行，后不返回任何行。 p>

我想出的解决方案是对每一行做一个foreach，检查它是否可见，但是代码真的很慢。每个组合框最多需要10秒。

任何人都知道如何解决这个问题？

非常感谢。

- 编辑 -

代码

  Dim listaDados As New Collection 
 Dim comboList（）As String 
 Dim currentValue As String 
 Dim splitValue（）As String 
 Dim i As Integer 
 Dim l As Variant 
 Dim lFiltered As Variant 
 Dim lastRow As Integer 
 
'这里我发现表中的最后一行
 lastRow = Sheets（SIP）。Range（A65536）。End（xlUp）.Row 
'这是因为当过滤器过滤一切，lastRow = 1所以我在lFiltered范围上得到一个错误，它成为Range（A2：F1）
如果lastRow< 2 then 
 lastRow = 2 
 End If 
'这里我得到一个数组，其中包含表中所有可见的行 - > lFiltered（row，column）= value 
 lFiltered = Sheets（SIP）。Range（A2：F& lastRow）.SpecialCells（xlCellTypeVisible）.Cells 
'我插入一个集合中的一切，所以它只允许我有一个每个值
错误恢复下
对于i = 1到UBound（lFiltered）
 currentValue = Trim（lFiltered ，column））
如果currentValue<> 0 then 
如果currentValue<> then 
'Cammel case the string 
 currentValue = UCase（Left（currentValue，1））& LCase（mid（currentValue，2））
'大写的之间的内容
 splitValue = Split（currentValue，（，2）
 currentValue = splitValue &（& UCase（splitValue（1））
'将新项目插入集合
 listaDados.Add Item：= currentValue，Key：= currentValue 
 End If 
 End If 
 Next i 
i = 1 
'这里我将集合复制到数组
 ReDim Preserve comboList（0）
 comboList（0）=
对于每个l在listaDados 
中ReDim保存comboList（i）
 comboList（i）= l 
i = i + 1 
下一个l 
 
 '这里我将该数组分配给组合框
 formPerda.Controls（cGrupo& column）.List = comboList 
  

---编辑---

这是我如何管理代码按我想要的方式工作。

 '获取过滤器显示的最后一行
 lastRow = Sheets（SIP）。Range（A65536）End（xlUp）。 Row 
'避免得到表的头
如果lastRow< 2 then 
 lastRow = 2 
 End If 
'获取autofilter显示的多个范围
设置lFilteredAux = Sheets（SIP）。Range（A2：F& ; lastRow）.Cells.SpecialCells（xlCellTypeVisible）
 
'检查是否有超过1个没有连续区域
如果Sheets（SIP）。Range（lFilteredAux.Address）.Areas。计数> 1 Then 
'如果是，请通过区域循环
对于i = 1到表（SIP）。范围（lFilteredAux.Address）.Areas.Count 
'到lFiltered数组
 ReDim Preserve lFiltered（i  -  1）
 lFiltered（i  -  1）= Sheets（SIP）。Range（lFilteredAux.Address）.Areas（i）
 i 
 Else 
如果只有一个区域，它会以旧的方式
 ReDim lFiltered（0）
 lFiltered（0）= Sheets（SIP）。Range lFilteredAux.Address）
结束如果
  

现在我有lFiltered数组有点不同方法我使用，但我调整我的foreach工作像这样：

  For i = 0到UBound（lFiltered）
对于j = 1到UBound（lFiltered（i））
 currentValue = Trim（lFiltered（i）（j，columnNumber））
 next j 
 next i 
  

非常感谢！ = D

解决方案

这里明显的性能下降是你在一个严格的循环中使用ReDim Preserve。

为了说明，这个小的ReDim Preserve语句做了很多工作。如果你有一个大小为4的数组，并将它ReDim它的大小5，它分配5个空格，并且还复制来自上一个数组的4个值。如果然后将它ReDim它的大小6，它分配6个空格，并且还复制来自上一个数组的5个值。

假设您有1000个值。在编写代码时，您认为您只是在数组中分配了1000个元素，并将其复制过来。这将是在线性时间，O（n）操作。事实上，你正在分配1 + 2 + 3 + 4 ... + 1000元素=分配和复制500,000，这将是多项式时间，一个O（n ^ 2）操作。

解决方案是：

1）在循环之外，找出数组的大小，然后只有ReDim保存一次。

也就是说，第一个：

  Dim totalSize为Long，i为Long 
 For i = 1 To Sheets（SIP）。Range（lFilteredAux.Address）.Areas.Count 
 totalSize + = 1 
 Next I 
  

一旦你有大小：

  ReDim Preserve lFiltered（totalSize-1）
对于i = 1到表（SIP）。范围（lFilteredAux.Address）.Areas.Count 
 lFiltered（i  -  1）= Sheets（SIP）。范围（lFilteredAux.Address）.Areas（i）
下一页i 
  

使用需要调整大小并且其ReDim Preserve需要特定大小的数组，请使用集合。在内部，集合被实现为类似链接列表，使得添加项目发生在恒定时间（因此对于每个操作的O（1）并且因此插入所有n个项目的O（n）总计）。

  Dim c as New Collection 
 ReDim Preserve lFiltered（totalSize  -  1）
 For i = 1 To Sheets（SIP ）.Range（lFilteredAux.Address）.Areas.Count 
 c.Add Sheets（SIP）。Range（lFilteredAux.Address）.Areas（i）
 Next i 
  

I have a UserForm in a sheet. In this form I have 6 combobox.

This combobox are populated from a sheet with 6 columns, each column goes to a combobox. After each combobox is selected, I make a filter at this sheet and repopulate the next one.

I'll give you an example to try to make it more clear.

I have a sheet with 6 columns:
Continent | Country | State | City | Street | Name of the building

This sheet have ALL the possible combinations for all this itens. For example: For each building in a street I have a row with all the same 5 first items and the last one changes.

When the user opens the form I populate the first combobox with the first column of the sheet (I do a routine to get unique items). When the user changes the first combobox, I apply a filter to the sheet in the first column and then I populate the second combobox with the filtered sheet.

My problem is how to get the filtered range. I'm doing this:

lastRow = Sheets("SIP").Range("A65536").End(xlUp).Row
lFiltered = Sheets("SIP").Range("A2:F" & lastRow).SpecialCells(xlCellTypeVisible).Cells

It works fine. But when I apply a filter and it hides, for exemple, only the row 10, the lFiltered variable will return only until row 9. It breaks on the first hidden row and does not return any row after that.

The solution I came up with is to do a foreach with every row and check if its visible or not, but the code gets really, really slow. It takes up to 10 seconds to populate each combobox.

Anyone have any idea how can I work around this issue?

Thank you very much.

-- edit --

Here is the important part of the code

Dim listaDados As New Collection
Dim comboList() As String
Dim currentValue As String
Dim splitValue() As String
Dim i As Integer
Dim l As Variant
Dim lFiltered As Variant
Dim lastRow As Integer

'Here I found the last row from the table
lastRow = Sheets("SIP").Range("A65536").End(xlUp).Row
'I do this because when the filter filters everything, lastRow = 1 so I got an erros on lFiltered range, it becames Range("A2:F1")
If lastRow < 2 Then
    lastRow = 2
End If
'Here I get an array with all the visible rows from the table -> lFiltered(row, column) = value
lFiltered = Sheets("SIP").Range("A2:F" & lastRow).SpecialCells(xlCellTypeVisible).Cells
'I have duplicated entries, so I insert everything in a Collection, so it only allows me to have one of each value
on error resume next
For i = 1 To UBound(lFiltered)
    currentValue = Trim(lFiltered(i, column))
    If currentValue <> 0 Then
        If currentValue <> "" Then
            'Cammel case the string
            currentValue = UCase(Left(currentValue, 1)) & LCase(Mid(currentValue, 2))
            'Upper case the content in between "( )"
            splitValue = Split(currentValue, "(", 2)
            currentValue = splitValue(0) & "(" & UCase(splitValue(1))
            'Insert new item to the collection
            listaDados.Add Item:=currentValue, Key:=currentValue
        End If
    End If
Next i
i = 1
'Here I copy the collection to an array
ReDim Preserve comboList(0)
comboList(0) = ""
For Each l In listaDados
    ReDim Preserve comboList(i)
    comboList(i) = l
    i = i + 1
Next l

'Here I assign that array to the combobox
formPerda.Controls("cGrupo" & column).List = comboList

--- edit ---

Here is how I managed the code to work the way I want.

'Get the last row the filter shows
lastRow = Sheets("SIP").Range("A65536").End(xlUp).Row
'To avoid to get the header of the table
If lastRow < 2 Then
    lastRow = 2
End If
'Get the multiple range showed by the autofilter
Set lFilteredAux = Sheets("SIP").Range("A2:F" & lastRow).Cells.SpecialCells(xlCellTypeVisible)

'Check if there is more than 1 no contiguous areas
If Sheets("SIP").Range(lFilteredAux.Address).Areas.Count > 1 Then
    'If Yes, do a loop through the areas
    For i = 1 To Sheets("SIP").Range(lFilteredAux.Address).Areas.Count
        'And add it to the lFiltered array
        ReDim Preserve lFiltered(i - 1)
        lFiltered(i - 1) = Sheets("SIP").Range(lFilteredAux.Address).Areas(i)
    Next i
Else
    'If there is only one area, it goes the old way
    ReDim lFiltered(0)
    lFiltered(0) = Sheets("SIP").Range(lFilteredAux.Address)
End If

Now I have the lFiltered array a little different than the way I was using, but I adapted my foreach to work like this:

For i = 0 To UBound(lFiltered)
        For j = 1 To UBound(lFiltered(i))
            currentValue = Trim(lFiltered(i)(j, columnNumber))
        next j
next i

Thanks a lot! =D

解决方案

The obvious performance sink here is that you are using ReDim Preserve in a tight loop.

To explain, that little ReDim Preserve statement does a lot of work. If you have an array of size 4 and you ReDim it to size 5, it allocates 5 spaces and also copies over the 4 values from the previous array. If you then ReDim it to size 6, it allocates 6 spaces and also copies over the 5 values from the previous array.

Say you have 1000 values total. When writing the code, you thought that you were merely allocating 1000 elements in the array and copying them over. This would be in linear time, an O(n) operation. In truth, you were allocating 1 + 2 + 3 + 4 ... + 1000 elements = allocating and copying 500,000, which would be in polynomial time, an O(n^2) operation.

The solution is either:

1) Outside the loop, figure out the size of your array and then only ReDim Preserve once.

That is, first:

Dim totalSize as Long, i as Long 
For i = 1 To Sheets("SIP").Range(lFilteredAux.Address).Areas.Count
    totalSize += 1
Next I

And once you have the size:

ReDim Preserve lFiltered(totalSize - 1)
For i = 1 To Sheets("SIP").Range(lFilteredAux.Address).Areas.Count
     lFiltered(i - 1) = Sheets("SIP").Range(lFilteredAux.Address).Areas(i)
Next i

2) Instead of using an array, which needs resizing, and whose ReDim Preserve requires a specific size, use a Collection. Internally, the Collection is implemented as something like a linked list, such that adding an item happens in constant time (so O(1) for each operation and so O(n) total for inserting all n items).

Dim c as New Collection
ReDim Preserve lFiltered(totalSize - 1)
For i = 1 To Sheets("SIP").Range(lFilteredAux.Address).Areas.Count
     c.Add Sheets("SIP").Range(lFilteredAux.Address).Areas(i)
Next i

这篇关于VBA选择已过滤单元格的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！