Excel 选择第一个过滤单元格，然后向下移动到下一个过滤单元格_Excel_Vba_Filter

Excel 选择第一个过滤单元格，然后向下移动到下一个过滤单元格

excel vba filter

Excel 选择第一个过滤单元格，然后向下移动到下一个过滤单元格,excel,vba,filter,Excel,Vba,Filter,我有一个包含联系人详细信息的Excel电子表格，例如： A B C D E 1 Select who you would to like to email: * Drop down list * 2 Name: Company: Role: Email Address1: Email Address2:

我有一个包含联系人详细信息的Excel电子表格，例如：

    A                 B            C            D                    E
1   Select who you would to like to email:      * Drop down list *
2   Name:            Company:      Role:        Email Address1:      Email Address2:
3   Michael Jackson  Jackson 5     Singer       MJ@J5.com            Michael@J5.com
4   Brian May        Queen         Guitarist    BM@Queen.com         Brian@Queen.com
5   Kurt Cobain      Nirvana       Singer       KC@Nirvana.com       Kurt@Nirvana.com
6   Freddie Mercury  Queen         Singer       FM@Queen.co.uk       Freddie@Queen.com
7   Pat Smear        Nirvana       Guitarist    PS@Foo.com           Pat@Foo.com

用户使用

D1

中的下拉列表选择电子邮件地址，然后运行宏以获取该列中的电子邮件地址

问题是，当用户应用过滤器时，比如说所有吉他手，它将选择第一个过滤行（

C4

），然后转到下一行而不是下一个过滤行，因此它将转到

C5

这是对代码的改编：

Sub SendEmail()

Dim objOutlook As Object
Dim objMail As Object
Dim RowsCount As Integer
Dim Index As Integer
Dim Recipients As String
Dim Category As String
Dim CellReference As Integer

Set objOutlook = CreateObject("Outlook.Application")
Set objMail = objOutlook.CreateItem(0)

RowsCount = ActiveSheet.AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Cells.Count - 1

Category = Range("D1")
Dim RowLimit As String
If Category = "Email Address1" Then
    CellReference = 4
ElseIf Category = "Email Address2" Then
    CellReference = 5
End If

Index = 0
While Index < RowsCount
    Set EmailAdrs = ActiveSheet.AutoFilter.Range.Offset(1).SpecialCells(xlCellTypeVisible).Cells(1, CellReference).Offset(0 + Index, 0)
    Recipients = Recipients & EmailAdrs.Value & ";"
    Index = Index + 1
Wend

 With objMail
    .To = Recipients
    .Subject = "This is the subject"
    .Display
End With

Set objOutlook = Nothing
Set objMail = Nothing

End Sub

以及：

我相信范围的

隐藏属性就是您想要的。以下代码适用于我：
Dim row As Range
For Each row In Range("MyTable").Rows
    If not row.EntireRow.Hidden Then
        ''' DO STUFF '''
    End If
Next

我总是发现，对每个

循环使用

，是在excel工作表中迭代数据的一种更干净的方法。“MyTable”是我给感兴趣的范围起的名字，但是如果您愿意，您可以输入一个范围限制，如range（“A1:D4”）
。尽管我认为使用命名范围是一种更好的做法，因为它使代码更具可读性
编辑：要解决您的评论
如果在命名范围的中间插入一行，则范围的限制将自动扩展。但是，如果您的表将成为工作表中的唯一数据，您也可以使用工作表对象的UsedRange
属性。例如：
Dim row As Range
For Each row In Worksheets("MySheet").UsedRange.Rows
    If not row.EntireRow.Hidden Then
        ''' DO STUFF '''
    End If
Next

如果只有表格的第一行，则可以使用以下方法将此范围扩展到整个表格：
dim FirstRow as Range
dim LastRow as Range
dim myTable as Range
set FirstRow = Range("A1:B1")
set LastRow = FirstRow.End(xlDown)
set myTable = Range(FirstRow, LastRow)

然后对每个

循环使用与前面相同的

。希望这有帮助
 请尝试以下代码：
Sub SendEmail()
    Dim objOutlook As Object
    Dim objMail As Object
    'Dim RowsCount As Integer
    'Dim Index As Integer
    Dim Recipients As String
    Dim Category As String
    Dim CellReference As Integer
    Dim RowLimit As String
    'New variables.
    Dim firstRow As Long
    Dim lastRow As Long
    Dim cell As Excel.Range
    Dim row As Long



    Set objOutlook = CreateObject("Outlook.Application")
    Set objMail = objOutlook.CreateItem(0)


    Category = Range("D1")
    If Category = "Email Address1" Then
        CellReference = 4
    ElseIf Category = "Email Address2" Then
        CellReference = 5
    End If



    With ActiveSheet

        'Find the first and last index of the visible range.
        firstRow = .AutoFilter.Range.Offset(1).SpecialCells(xlCellTypeVisible).row
        lastRow = .Cells(.Rows.Count, 1).End(xlUp).row


        'Iterate through all the rows between [firstRow] and [lastRow] established before.
        'Some of those rows are hidden, but we will check it inside this loop.
        For row = firstRow To lastRow

            Set cell = .Cells(row, CellReference)

            'We are checking here if this row is hidden or visible.
            'Note that we cannot check the value of property Hidden of a single cell,
            'since it will generate Run-time error '1004' because a single cell cannot be
            'hidden/visible - only a whole row/column can be hidden/visible.
            'That is why we need to refer to its .EntireRow property first and after that we
            'can check its .Hidden property.
            If Not cell.EntireRow.Hidden Then

                'If the row where [cell] is placed is not hidden, we append the value of [cell]
                'to variable Recipients.
                Recipients = Recipients & cell.Value & ";"
            End If

        Next row

    End With


    With objMail
        .To = Recipients
        .Subject = "This is the subject"
        .Display
    End With

    Set objOutlook = Nothing
    Set objMail = Nothing

End Sub

对于任何对此解决方案感兴趣的人，我意识到在单元格值中测试过滤器的逻辑要快得多，而不是检查过滤器是否隐藏了列（在超过10.000行的表格中），因此不需要每次选择整行，只需选择一个单元格
当然，您需要事先知道过滤器的表达式，这在本代码中没有涉及
例如，如果过滤器测试值小于0.5，则最好尝试：
Range("U1").Select 'The column where the filter is being applied
ActiveCell.Offset(1, 0).Select
Do Until CDbl(ActiveCell.Formula) < 0.5 'The condition applied in the filter
    ActiveCell.Offset(1, 0).Select
Loop

Range（“U1”）。选择应用过滤器的列
ActiveCell.Offset（1，0）。选择
直到CDbl（ActiveCell.Formula）<0.5'过滤器中应用的条件
ActiveCell.Offset（1，0）。选择
环
请注意，虽然范围可能会改变，但一天可能有150行，另一天可能有168行，因此可能会上升或下降；您的代码还能工作吗？请参阅我的编辑以了解更多详细信息。要进行总结，请使用UsedRange
或使用Range
对象的End方法将单行扩展到完整的数据集。这非常有效！非常感谢。我很感激你花了一些时间来编写代码，但是你介意为我解释一下吗，这样我就可以完全理解正在发生的事情了on@BenSmith为了更好地理解，我在代码中添加了一些附加注释。如果您还有其他问题，请在评论中告诉我。我意识到，对于大型图纸（超过10000行），for循环非常耗时。你知道一个有效的替代方案吗？
dim FirstRow as Range
dim LastRow as Range
dim myTable as Range
set FirstRow = Range("A1:B1")
set LastRow = FirstRow.End(xlDown)
set myTable = Range(FirstRow, LastRow)

Sub SendEmail()
    Dim objOutlook As Object
    Dim objMail As Object
    'Dim RowsCount As Integer
    'Dim Index As Integer
    Dim Recipients As String
    Dim Category As String
    Dim CellReference As Integer
    Dim RowLimit As String
    'New variables.
    Dim firstRow As Long
    Dim lastRow As Long
    Dim cell As Excel.Range
    Dim row As Long



    Set objOutlook = CreateObject("Outlook.Application")
    Set objMail = objOutlook.CreateItem(0)


    Category = Range("D1")
    If Category = "Email Address1" Then
        CellReference = 4
    ElseIf Category = "Email Address2" Then
        CellReference = 5
    End If



    With ActiveSheet

        'Find the first and last index of the visible range.
        firstRow = .AutoFilter.Range.Offset(1).SpecialCells(xlCellTypeVisible).row
        lastRow = .Cells(.Rows.Count, 1).End(xlUp).row


        'Iterate through all the rows between [firstRow] and [lastRow] established before.
        'Some of those rows are hidden, but we will check it inside this loop.
        For row = firstRow To lastRow

            Set cell = .Cells(row, CellReference)

            'We are checking here if this row is hidden or visible.
            'Note that we cannot check the value of property Hidden of a single cell,
            'since it will generate Run-time error '1004' because a single cell cannot be
            'hidden/visible - only a whole row/column can be hidden/visible.
            'That is why we need to refer to its .EntireRow property first and after that we
            'can check its .Hidden property.
            If Not cell.EntireRow.Hidden Then

                'If the row where [cell] is placed is not hidden, we append the value of [cell]
                'to variable Recipients.
                Recipients = Recipients & cell.Value & ";"
            End If

        Next row

    End With


    With objMail
        .To = Recipients
        .Subject = "This is the subject"
        .Display
    End With

    Set objOutlook = Nothing
    Set objMail = Nothing

End Sub

Range("U1").Select 'The column where the filter is being applied
ActiveCell.Offset(1, 0).Select
Do Until CDbl(ActiveCell.Formula) < 0.5 'The condition applied in the filter
    ActiveCell.Offset(1, 0).Select
Loop