如何在 for each 循环中跳过当前单元格

How to skip current cell in a for each loop

在 excel 中,我有以下代码,它为 K 列中包含电子邮件地址的每个单元格发送电子邮件。

除了 table 中的 header 不是电子邮件地址,这会起作用,因此它会破坏代码。我试图通过指定 "if cell.value = CONTACT METHOD, which is the header name text, then go to Next cell"

来跳过 header

但这会导致 "Next without for" 错误。

Sub Mail_small_Text_Outlook()
'For Tips see: http://www.rondebruin.nl/win/winmail/Outlook/tips.htm
'Working in Office 2000-2013
Dim OutApp As Object
Dim OutMail As Object
Dim cell As Range

Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")

On Error GoTo cleanup
For Each cell In Columns("K").Cells.SpecialCells(xlCellTypeConstants)

    If cell.Value Like "*@*" Then
    finaladdress = cell.Value

    Else
    finaladdress = cell.Value & "@email.smsglobal.com"

        Set OutMail = OutApp.CreateItem(0)
        On Error Resume Next
        With OutMail
            .To = finaladdress
            .Subject = "Reminder"
            .Body = "Dear " & Cells(cell.Row, "A").Value _
                  & vbNewLine & vbNewLine & _
                    "Please contact us to discuss bringing " & _
                    "your account up to date"
            'You can add files also like this
            '.Attachments.Add ("C:\test.txt")
            .Display
        End With
        On Error GoTo 0
        Set OutMail = Nothing
    End If
Next cell

cleanup:
Set OutApp = Nothing
Application.ScreenUpdating = True
End Sub

您可以将 FOR/EACH 循环中的代码包含在单独的 IF 语句中,如下所示:

Sub Mail_small_Text_Outlook()
'For Tips see: http://www.rondebruin.nl/win/winmail/Outlook/tips.htm
'Working in Office 2000-2013
Dim OutApp As Object
Dim OutMail As Object
Dim cell As Range

Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")

On Error GoTo cleanup
For Each cell In Columns("K").Cells.SpecialCells(xlCellTypeConstants)
    If cell.Value = "CONTACT METHOD" Then
        'Do Nothing, or Enter code here
    Else
        If cell.Value Like "*@*" Then
        finaladdress = cell.Value

        Else
        finaladdress = cell.Value & "@email.smsglobal.com"

            Set OutMail = OutApp.CreateItem(0)
            On Error Resume Next
            With OutMail
                .To = finaladdress
                .Subject = "Reminder"
                .Body = "Dear " & Cells(cell.Row, "A").Value _
                      & vbNewLine & vbNewLine & _
                        "Please contact us to discuss bringing " & _
                        "your account up to date"
                'You can add files also like this
                '.Attachments.Add ("C:\test.txt")
                .Display
            End With
            On Error GoTo 0
            Set OutMail = Nothing
        End If
    End If
Next cell

cleanup:
Set OutApp = Nothing
Application.ScreenUpdating = True
End Sub

如果您的目标是在向下循环列 K 中跳过单元格 K1,则:

For Each cell In Columns("K2:K" & Rows.Count).Cells.SpecialCells(xlCellTypeConstants)