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

时间:2015-07-23 16:45:09

标签: excel vba excel-vba loops while-loop

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

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

此代码检查是否已应用过滤器并计算行数(如果有一行或不是一行),然后检查以查看应通过电子邮件发送的行({{1}中的“类别”是不同个人的工作岗位)然后获取所需的电子邮件地址,我遇到的问题是说我有以下数据(这只是我想做的一个例子):

I1

我过滤了A列中的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 和B列中的Jones,以获得返回的两行,而不是获取电子邮件地址Femaledef@abc.co.uk电子邮件地址ghi@abc.co.ukdef@abc.co.uk因为它找到应用了过滤器的第一行,然后转到下一个单元格而忽略过滤器。

有没有办法可以解决这个问题,以便获得过滤后的单元格?

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

2 个答案:

答案 0 :(得分:0)

您可以使用

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是一个Object变量,它包含它所代表的单元格的大量信息。

因此,如果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获取/设置的所有内容

答案 1 :(得分:0)

用以下代码替换代码的底部:

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