VBA：select第一个过滤的单元格，然后移到下一个单元格

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

ABCDE 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的下拉列表（例如，电子邮件1）来select他们想要通过电子邮件发送的电子邮件地址，然后运行一个macros来获取该列中的电子邮件地址。 这一点是好的，我有它的工作。 问题是，当用户应用filter，说所有吉他手，它会select第一个过滤行（ 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 

但是，这只会select第一个过滤的单元格，然后是任何单元格下面的。

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

 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 

我试过只通过可见的单元格。

我从另一个StackOverflow问题（ 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 

还有来自其他网页的其他各种想法和事情，但似乎并不奏效。

有人可以帮助我，请记住我是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表格中的数据。 “MyTable”是我给出的关注范围的名称，但是如果您愿意，您可以inputRange("A1:D4")的限制。 尽pipe我认为使用命名范围是一个更好的做法，因为它使您的代码更具可读性。

编辑：要解决您的评论…

如果向命名范围的中间插入一行，范围的限制将自动展开。 尽pipe如果您的表将成为工作表中唯一的数据，您也可以使用工作表对象的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循环。 希望这可以帮助！