获取单元格中的值列表

时间:2012-07-19 16:22:21

标签: excel vba excel-vba

我有一张Excel工作表,我在其上创建了一个由许多值组成的列表。我还创建了一个宏,它显示了一个用户表单,其中这些值是硬编码的。

现在我希望表单中的那些值能够自动/编程/动态地添加到我的用户表单列表中,以便将来,如果我想减少列表中的值,那么我就不必更改宏再次。

我一直在寻找答案,但我找不到我要找的东西是不成功的。

我已录制此宏,但我不知道如何从中检索值:

Sub Macro7()
'
' Macro7 Macro
'

'
Range("E1").Select
ActiveSheet.Range("$A$1:$AE$175").AutoFilter Field:=5
End Sub

2 个答案:

答案 0 :(得分:0)

您指定的宏将为您的活动工作表启用自动过滤功能。这将提供列标题,允许用户过滤到感兴趣的内容。 假设这种工作表的过滤是你想要的,你可以使用类似的东西:

Dim r As Range
'Note: set r to something useful, such as worksheet.Cells

Dim vis As Range
Set vis = r.SpecialCells(xlCellTypeVisible)

'now vis holds a special "Range" object referring to the visible cells.
'since (auto) filtering hides some cells, this vis range will help show only the cells that remain visible.
'the output of SpecialCells, you should assume holds a complex Range,
'which is composed of multiple Areas that are wrapped in one single Range object
'the separate areas help you distinguish the visible cells from the hidden cells
'fyi, various safety checks you can do: vis Is Range, vis Is Nothing

Dim a as Areas
Set a = r.Areas

Dim cr as Range
For Each cr in a
    'cr refers to a single (i.e. normal and contiguous) area range
    'where you can use cr.Row, cr.Column, cr.Rows.Count, cr.Columns.Count
Next

因此,当您进行过滤时,可以使用SpecialCells(xlCellTypeVisible)来显示非隐藏单元格,这些单元格表示为包含表示连续范围的区域的范围。

答案 1 :(得分:0)

使用名为UReports且具有名为lbxReport的列表框的用户窗体,使用这样的代码用列E中的值填充列表框

Sub ShowUf()

    Dim ufReports As UReports
    Dim rCell As Range
    Dim colUnique As Collection
    Dim i As Long

    Set ufReports = New UReports
    Set colUnique = New Collection

    'loop through the cells in column E
    For Each rCell In Sheet1.Range("E2", Sheet1.Cells(Sheet1.Rows.Count, 5).End(xlUp)).Cells
        'Collections can't have duplicate keys, so we try to add all the values.  If there
        'are duplicates, the 'On Error' ignores them and we're left with a collection of
        'only unique values from column E
        On Error Resume Next
            colUnique.Add rCell.Value, CStr(rCell.Value)
        On Error GoTo 0
    Next rCell

    'loop through the collection and add them to the listbox
    For i = 1 To colUnique.Count
        ufReports.lbxReport.AddItem colUnique.Item(i)
    Next i

    'Show the form
    ufReports.Show

End Sub
相关问题