VBA转到下一个过滤的单元格

我目前使用下面的代码：

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) If ActiveSheet.FilterMode = True Then RowsCount = ActiveSheet.AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Cells.Count - 1 ElseIf ActiveSheet.FilterMode = False Then RowsCount = Application.CountA(Range("A2:A" & Rows.Count)) - 1 End If ' In Range("I1") there is the job category the user wants to email Category = Range("I1") If Category = Range("S2") Then ' CellReference is the amount of columns to the right of column A, ie Column A is 0 so CellReference below is J - which is the column location of the email address according to that category CellReference = 10 ElseIf Category = Range("S3") Then CellReference = 14 ElseIf Category = Range("S4") Then CellReference = 18 ElseIf Category = Range("S5") Then CellReference = 16 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 

这段代码检查是否应用了一个filter，如果有一个或者不是一个，则计算行数，然后检查谁应该通过电子邮件发送（ I1的“类别”是不同的个人），然后得到所需的电子邮件地址，我遇到的问题是说我有以下数据（这只是我想要做的一个例子）：

 Column A Column B Column C Smith Male [e-mail] Jones Male [e-mail] Smith Female [e-mail] Jones Female [e-mail] Smith Male [e-mail] Smith Female [e-mail] Smith Female [e-mail] Jones Female [e-mail] 

我在列A中的Jones和列B中的Female中筛选返回的两行，而不是得到电子邮件地址[e-mail]和[e-mail]它将得到电子邮件地址[e-mail]和[e-mail]因为它发现应用了filter的第一行然后不考虑filter而进入下一个单元。

有没有一种方法可以解决这个问题，以便它得到过滤的单元格？

需要指出的是，filter可能并不总是相同的，所以它不一定是列A和列B，它可能只是列A或列B的。

Answer 1

用下面的代码replace代码的底部部分：

 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 

Answer 2

您可以使用

1）select一个范围:(当然，你可以使用一个公式，而不是一个固定的范围）

 Dim Rng As Range If Category = Range("S2") Then ' CellReference is the amount of columns to the right of column A, ie Column A is 0 so CellReference below is J - which is the column location of the email address according to that category CellReference = 10 'Set your range Set Rng = [Insert here your criteria to set the range when CellReference = 10] ElseIf Category = Range("S3") Then CellReference = 14 'Set your range Set Rng = [Insert here your criteria to set the range when CellReference = 14] ElseIf Category = Range("S4") Then CellReference = 18 'Set your range Set Rng = [Insert here your criteria to set the range when CellReference = 18] ElseIf Category = Range("S5") Then CellReference = 16 'Set your range Set Rng = [Insert here your criteria to set the range when CellReference = 16] End If 

（考虑使用Select Case而不是ElseIf ）然后循环范围

 'You need to replace YourSheetName with the real name of your sheet 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 

mCell是一个Objectvariables，它包含了它所代表的单元格的大量信息。

所以，如果mCell是包含“Hello World”的A1 Cell：

 mCell.Address will be "$A$1" mCell.Value will be "Hello World" mCell.Offset(0, 2).Address will be "$C$1" 

您也可以获取和/或设置很多其他数据：

 mCell.NumberFormat mCell.RowHeight mCell.Formula 

看看局部variables，看看你能得到/设置为mCell