选择第一个过滤的单元格，然后向下移动到下一个过滤的单元格 [英] Select the first filtered cell then move onto the next filtered cell down

问题描述

我有一个包含联系方式的Excel电子表格，例如:

I have an Excel spreadsheet that has contact details, for example:

    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       [e-mail]            [e-mail]
4   Brian May        Queen         Guitarist    [e-mail]         [e-mail]
5   Kurt Cobain      Nirvana       Singer       [e-mail]       [e-mail]
6   Freddie Mercury  Queen         Singer       [e-mail]       [e-mail]
7   Pat Smear        Nirvana       Guitarist    [e-mail]           [e-mail]

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

A user selects an email address using the drop down list in D1 then runs a macro that gets the email addreses in that column.

问题是，当用户应用一个过滤器(例如所有吉他手)时，它将选择第一个过滤的行(C4)，然后转到下一行而不是下一个过滤的行，因此它将转到.

The problem is when a user applies a filter, say all guitarists, it will select the first filtered row (C4) and then go to the next row rather than the next filtered row, so it would go to 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

我尝试遍历隐藏的行:

While Index < RowsCount
   Do While Rows(ActiveCell.Row).Hidden = True
       'ActiveCell.Offset(1).Select
       Set EmailAdrs = ActiveSheet.AutoFilter.Range.Offset(1).SpecialCells(xlCellTypeVisible).Cells(1, CellReference).Offset(0 + Index, 0)
        Recipients = Recipients & EmailAdrs.Value & ";"
        Index = Index + 1
        ActiveCell = ActiveCell.Offset(0 + Index, 0).Select
    Loop
Wend

我尝试只浏览可见的单元格.

I tried going through only cells that are visible.

我尝试了 VBA中的想法 :

If ActiveSheet.FilterMode = True Then
    With ActiveSheet.AutoFilter.Range
        For Each a In .Offset(1).Resize(.Rows.Count).SpecialCells(xlCellTypeVisible).Areas
            Recipients = Recipients & a(1, CellReference) & ";"
        Next
    End With
    MsgBox Replace(Recipients, ";;", vbNullString)
End If

并且:

Dim Rng As Range
If Category = Range("S2") Then
    CellReference = 10
    'Set your range
    Set Rng = Range("A1:B2")
ElseIf Category = Range("S3") Then
    CellReference = 14
    'Set your range
    Set Rng = Range("C1:D2")
ElseIf Category = Range("S4") Then
    CellReference = 18
    'Set your range
    Set Rng = Range("F1:G2")
ElseIf Category = Range("S5") Then
    CellReference = 16
    'Set your range
    Set Rng = Range("H1:J2")
End If

For Each mCell In ThisWorkbook.Sheets("YourSheetName").Range(Rng).SpecialCells(xlCellTypeVisible)
    'Get cell address
    mAddr = mCell.Address
    'Get the address of the cell on the column you need
    NewCellAddr = mCell.Offset(0, ColumnsOffset).Address
    'Do everything you need
Next mCell

推荐答案

尝试以下代码:

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

这篇关于选择第一个过滤的单元格，然后向下移动到下一个过滤的单元格的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！