Question

我想做的事对我来说似乎很简单，但我找不到办法。我有一个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中的下拉列表选择要发送电子邮件的电子邮件地址，比如电子邮件1，然后运行一个宏来获取该列中的电子邮件地址。这一点很好，我有它的工作。问题是，当用户应用过滤器时，比如所有吉他手，它将选择第一个过滤的行（C4），然后转到下一行而不是下一个过滤的行，因此它将转到{{ 1}}。

这是我目前正在使用的代码的改编：

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

我尝试过只查看可见的单元格。

我从其他StackOverflow问题（VBA Go to the next filtered cell）尝试了其他人的想法：

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

和

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

来自其他网页的各种其他想法和事情，但它们似乎不起作用。

有人可以帮助我，请记住，我是VBA的新手，所以没有太多的知识。

Answer 1

试试这段代码：

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

Answer 2

我相信范围的Hidden属性就是你想要的。以下代码对我有用：

Dim row As Range
For Each row In Range("MyTable").Rows
    If not row.EntireRow.Hidden Then
        ''' DO STUFF '''
    End If
Next

我一直发现使用For Each循环是一种更加清晰的方法来迭代excel表中的数据。＆＃34; MyTable的＆＃34;是我给感兴趣的范围的名字，但如果你愿意，你可以输入范围的限制，如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)

然后使用与之前相同的For Each循环。希望这有帮助！

Answer 3

对于对此解决方案感兴趣的人，我意识到在单元格值中测试过滤器逻辑的速度比快得多，而不是检查过滤器是否隐藏了列（包含超过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

VBA：选择第一个过滤的单元格然后向下移动到下一个单元格

3 个答案: