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 和 789@123.co.uk 因为它找到应用了过滤器的第一行然后转到下一个单元格忽略过滤器。

有没有办法解决这个问题，以便它获取过滤的单元格？

重要的是要指出过滤器可能并不总是相同的，所以它不会总是 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