返回唯一值并避免在未过滤范围内循环

时间:2012-11-29 15:00:23

标签: excel vba filtering

这里的第一篇文章,所以我希望我足够清楚。

我在工作表上有一张表,我正在使用它。我已经将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 个答案:

答案 0 :(得分: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使用连续数据的方式。所以在调用函数中,我不得不遍历返回范围中的区域。这确实为我原本希望避免的原始调用函数增加了一定程度的开销(我想返回一个范围,只有一个区域可以轻松迭代)。

我发现迭代从上面返回的范围/区域的最可靠的方法是基于这个片段,我以一种方式或另一种方式在大量地方使用(从表中拉出不同的列等等:< / 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