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

Question

我目前正在使用以下代码：

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

此代码检查是否已应用过滤器并计算行数（如果有或没有），然后检查应向谁发送电子邮件（I1 中的“类别”是不同个人的工作职位），然后获取所需人员的电子邮件地址，我遇到的问题是我有以下数据（这只是我想做的一个例子）：

Column A         Column B             Column C
Smith            Male                 123@123.co.uk
Jones            Male                 abc@abc.co.uk
Smith            Female               456@123.co.uk
Jones            Female               def@abc.co.uk
Smith            Male                 789@123.co.uk
Smith            Female               101112@123.co.uk
Smith            Female               141516@123.co.uk
Jones            Female               ghi@abc.co.uk

我过滤 A 列中的 Jones 和 B 列中的 Female 以返回两行，而不是获取电子邮件地址 def@abc.co.uk 和 ghi@abc.co.uk 它将获得电子邮件地址 def@abc.co.uk 和 @ 987654329@，因为它找到应用了过滤器的第一行，然后忽略过滤器进入下一个单元格。

有什么方法可以解决这个问题，以便获得过滤后的单元格？

重要的是要指出过滤器可能并不总是相同的，因此它不会总是同时是 A 列和 B 列，它可能只是 A 列或只是 B 列。

Answer 1

将代码的底部替换为：

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) 选择范围：（当然可以用公式代替固定范围）

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 是一个对象变量，其中包含有关它所代表的单元格的大量信息。

所以，如果 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

查看局部变量以了解您可以为 mCell 获取/设置的所有内容