返回唯一值并避免遍历未过滤的范围

Posted 2023-03-10

【中文标题】返回唯一值并避免遍历未过滤的范围

【英文标题】：Returning unique value and avoid looping through an unfiltered range

【发布时间】：2012-11-17 16:33:48

【问题描述】：

第一次在这里发帖，所以我希望我足够清楚。

我正在使用的工作表上有一个表格。我已将 listObject 传递给一个类，该类可以从中返回各种数据。我想通过过滤指定的列标题来检索唯一列表。

我的问题是这样的：

我能否在过滤后返回包含所有行的范围，而无需手动循环遍历整个未过滤的范围？

我当前的代码在（未过滤的）范围内循环，寻找唯一的条目，如下所示。在我的测试工作表上花费了相当多的时间，所以不要认为它对于操作示例是可行的。

Public Function returnUniqueList(col As String) As Collection
' get unqiue lists from the table.  Useful for things like LCPs or ballast types
' returns as list of strings

Dim i As Integer
Dim r As Excel.Range
Dim reqCol As Integer
Dim tempString As String
' collection of strings with the unique values
Dim retString As New Collection

reqCol = returnColId(col)

On Error GoTo errorCatch

' collect the unique values
For Each r In pLO.Range.rows

    If Not InCollection(retString, r.Cells(1, reqCol)) Then
        ' add to the collection, including the key
        If r.Cells(1, reqCol) <> "" Then
           retString.Add r.Cells(1, reqCol), r.Cells(1, reqCol)
        End If
    End If
Next r

Set returnUniqueList = retString
Exit Function
errorCatch:
  MsgBox "Error returning unique list: " + Err.Description

End Function

【参考方案1】：

因此，在使用了各种内置的 excel/VBA 功能之后，我选择了高级过滤器。我遇到的一个问题是，当我过滤一列时，我想将过滤后的表返回给调用代码。上面的函数现在看起来像这样：

Public Function returnUniqueList(col As String, searchTerm As String) As Excel.range
' get unique lists from the table.  Useful for things like LCPs or ballast types
' returns as excel.range

Dim reqCol As Integer

On Error GoTo errorCatch

reqCol = returnColId(col)
Dim critRange As String
Dim cr As Excel.range


critRange = "=""=" + searchTerm + "*"""

pWkSht.Cells(1, 1000) = col
pWkSht.Cells(2, 1000) = critRange

Set cr = pWkSht.range(pWkSht.Cells(1, 1000), pWkSht.Cells(2, 1000))
' filter for unique entries on this column
pLO.range.Columns(reqCol).Select
pLO.range.Columns(reqCol).AdvancedFilter Action:=xlFilterInPlace, Unique:=True, CriteriaRange:=cr


Set returnUniqueList = pLO.range.SpecialCells(xlCellTypeVisible).EntireRow
pWkSht.Cells(1, 1000) = Empty
pWkSht.Cells(2, 1000) = Empty
Exit Function

errorCatch:
MsgBox "Error returning unique list: " + Err.Description

End Function

我发现棘手的事情是在调用函数中处理范围。我发现excel范围可以包含“区域”。这是由于 excel 处理连续数据的方式。所以在调用函数中，我必须遍历返回范围内的区域。这确实在我希望避免的原始调用函数中增加了一定程度的开销（我想返回一个范围，一个可以轻松迭代的区域）。

我发现遍历从上面返回的范围/区域的最可靠方法是基于这个 sn-p，我以一种或另一种方式在大量地方使用它（从表中拉出不同的列，等等：

Set devices = edh.returnUniqueList("DaliCct", lcp)
' filter by the requested LCP

'clear down the dali ccts box
daliCctsListBox.Clear

' cycle through the returned areas, retrieving the relvant info
For i = 1 To devices.Areas.Count
    For rowInd = 1 To devices.Areas(i).rows.Count
        Dim r As Excel.range
        For Each r In devices.Areas(i).rows(rowInd)

         If (r.Cells(daliCctColId) <> "") And (r.Cells(daliCctColId) <> "DaliCct") Then
             daliCctsListBox.AddItem r.Cells(daliCctColId)
             bAdded = True
         End If
        Next r
    Next rowInd
Next i