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

问题描述

我想做的似乎对我来说很简单，但我找不到一种方法。我有一个excel电子表格，其中有很多联系方式，例如：

  ABCDE 
 1选择谁你会喜欢电子邮件：*下拉列表* 
 2名称：公司：角色：电子邮件地址1：电子邮件地址2：
 3迈克尔杰克逊杰克逊5歌手[e-mail] [e-mail] 
 4 Brian May女王吉他手[e-mail] [e-mail] 
 5 Kurt Cobain Nirvana歌手[e-mail] [e-mail] 
 6 Freddie Mercury女王歌手FM @ Queen。 co.uk [e-mail] 
 7 Pat Smear Nirvana吉他手[e-mail] [e-mail] 
  

A用户使用 D1 中的下拉列表选择要发送的电子邮件地址，如电子邮件1，然后运行一个获取该列中的电子邮件地址。这一点很好，我有它的工作。问题是，当用户应用过滤器时，说所有吉他手，它将选择第一个过滤行（ 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）
设置objMail = objOutlook.CreateItem（0）
 
 RowsCount = ActiveSheet.AutoFilter.Range.Columns（1）.SpecialCells（xlCellTypeVisible）.Cells.Count  - 1 
 
 Category = Range（D1）
 Dim RowLimit As String 
如果Category =Email Address1然后
 CellReference = 4 
 ElseIf类别=Email Address2然后
 CellReference = 5 
如果
 
 I ndex = 0 
虽然Index< RowsCount 
设置EmailAdrs = ActiveSheet.AutoFilter.Range.Offset（1）.SpecialCells（xlCellTypeVisible）.Cells（1，CellReference）.Offset（0 + Index，0）
收件人=收件人& EmailAdrs.Value& ; 
索引=索引+ 1 
 Wend 
 
带objMail 
 .To =收件人
 .Subject =这是主题
。显示
结束
 
设置objOutlook =没有
设置objMail =没有
 
结束Sub 
  

但是，这只会选择第一个过滤的单元格，然后再选择下面的单元格。

I尝试了很多不同的想法，例如循环隐藏的行：

 虽然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）
收件人=收件人& EmailAdrs.Value& ; 
索引=索引+ 1 
 ActiveCell = ActiveCell.Offset（0 +索引，0）。选择
循环
 Wend 
  pre> 
 
 
我已经尝试过只有可见的单元格。
 
 
 
我尝试过其他人的想法StackOverflow问题（ VBA转到下一个过滤的单元格）：
 如果ActiveSheet.FilterMode = True然后
与ActiveSheet.AutoFilter.Range 
对于每个a在.Offset（ 1）.Resize（.Rows.Count）.SpecialCells（xlCellTypeVisible）.Areas 
收件人=收件人& a（1，CellReference）& ; 
下一个
结束
 MsgBox替换（收件人，;，vbNullString）
如果
  
 And：
  Dim Rng As Range 
如果Category = Range （S2）然后
 CellReference = 10 
'设置范围
设置Rng =范围（A1：B2）
 ElseIf类别=范围（S3）然后
 CellReference = 14 
'设置范围
设置Rng =范围（C1：D2）
 ElseIf类别=范围（S4）然后
 CellReference = 18 
'设置范围
设置Rng =范围（F1：G2）
 ElseIf类别=范围（S5）然后
 CellReference = 16 
'设置范围
设置Rng =范围（H1：J2）
结束如果
 
对于每个mCell In ThisWorkbook.Sheets（YourSheetName）。Range（Rng）。 SpecialCells（xlCellTypeVisible）
'获取单元格地址
 mAddr = mCell.Address 
'获取所需列的单元格地址
 NewCellAddr = mCell.Offset（0，ColumnsOffset ）.Address 
'做你需要的一切
下一个mCell 
  
和其他网页上的各种其他想法和内容，但似乎不起作用。
 
 
 
有人可以帮我，请请记住，我是VBA的新人，所以没有很多的知识。
解决方案
尝试这段代码： / p> 
 
 
  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 
'新变量。 
 Dim firstRow As Long 
 Dim lastRow As Long 
 Dim cell As Excel.Range 
 Dim row As Long 
 
 
 
设置objOutlook = CreateObject（Outlook.Application）
设置objMail = objOutlook.CreateItem（0）
 
 
类别=范围（D1）
如果类别=Email Address1然后
 CellReference = 4 
 ElseIf类别=电子邮件地址2然后
 CellReference = 5 
结束如果
 
 
 
使用ActiveSheet 
 
'查找可见范围的第一个和最后一个索引。 
 firstRow = .AutoFilter.Range.Offset（1）.SpecialCells（xlCellTypeVisible）.row 
 lastRow = .Cells（.Rows.Count，1）.End（xlUp）.row 
 
 
'迭代到之前建立的[firstRow]和[lastRow]之间的所有行。 
'这些行中的一些被隐藏，但是我们将在此循环内检查它。 
对于row = firstRow to lastRow 
 
设置单元格= .Cells（row，CellReference）
 
'我们正在检查此行是否隐藏或可见。 
'请注意，我们无法检查单个单元格的隐藏值
'，因为它会生成运行时错误'1004'，因为单个单元格不能为
'隐藏/可见 - 只有整行/列可以隐藏/可见。 
'这就是为什么我们首先要引用它的.EntireRow属性，之后我们
'可以检查它的.Hidden属性。 
如果不是cell.EntireRow.Hidden然后
 
'如果放置[cell]的行不被隐藏，我们将[cell] 
'的值追加到可变收件人。 
收件人=收件人& cell.Value& ; 
结束如果
 
下一行
 
结束
 
 
带objMail 
 .To =收件人
 .Subject =这是主题
。显示
结束与
 
设置objOutlook =没有
设置objMail =没有
 
 End Sub 
  
 
What I want to do seems pretty simple to me but I cannot find a way of doing it. I have an excel spreadsheet that has a lot of contact details in it, 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]
A User selects what email address they'd like to email using the drop down list in D1, say email 1, then runs a macro that gets the email addreses in that column. This bit is fine and I have it working. The problem is that 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.

This is an adaption of the code that I am currently using:
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
But this will only select the first filtered cell and then whatever the cell is below that.

I have tried a lot of different ideas, such as looping through rows that are hidden:
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 have tried going through only cells that are visible.

I have tried other people's ideas from another StackOverflow question (VBA Go to the next filtered cell):
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
And:
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
And various other ideas and things from other webpages, but they don't seem to work.

Can someone please help me, and please bear in mind that I am new to VBA so don't have a great deal of knowledge.
解决方案
Try this code:
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


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