如果列為空，則停止宏excel vba

Question

我已經制作了一些代碼但是如果范圍R2：34是空白的，它仍會打開模板電子郵件，但沒有數據。 請告訴我我在哪里做錯連接。

Sub 1()
    Dim OutApp As Object
    Dim OutMail As Object
    Dim sTo As String
    Dim spo As String
    Dim emailRng As Range, cl As Range, dtrecuta As Range
    Dim c As Range
For Each cell In Cells.Range("N2:N34")
If LCase(Cells(cell.Row, "N").Value) = "0" Or LCase(Cells(cell.Row, "N").Value) < "480" Then
On Error Resume Next
Cells(cell.Row, "R").Value = Cells(cell.Row, "M").Value
Else
Cells(cell.Row, "R").Value = Null
End If
Next cell
    a = CLng(Date)
    Set emailRng = Worksheets("Sheet1").Range("r2:r34")
    Set dtrecuta = Worksheets("Sheet1").Range("P2")
    For Each cl In emailRng
        sTo = sTo & ";" & cl.Value
    Next
    sTo = Mid(sTo, 2)
        Set OutApp = CreateObject("Outlook.Application")
        Set OutMail = OutApp.CreateItemFromTemplate("C:\Users\Marius\AppData\Roaming\Microsoft\Templates\statistica.oft")
    On Error Resume Next
    With OutMail
        .To = sTo
        .CC = ""
        .BCC = ""
        .Subject = "TESTARE Statistica pentru data de " & dtrecuta
        strbody = "Buna " & " , " & vbNewLine & vbNewLine & _
                  "Te rog sa trimiti statistica astazi " & a & " pana in ora 10:00, " & _
                  " pentru data de " & dtrecuta & vbNewLine & vbNewLine & "O zi buna." & _
                  " " & vbNewLine & vbNewLine & " Acesta este un mesaj automat nu raspundeti la acest e-mail. "
        .Display
        .Body = strbody & Signature
        .send
    End With
            On Error GoTo cleanup
            Set OutMail = Nothing
cleanup:
    Set OutMail = Nothing
    Set OutApp = Nothing
    Application.ScreenUpdating = True

End Sub

Answer 1

在設置范圍后添加IF語句以檢查是否所有空白單元格：

Set emailRng = Worksheets("Sheet1").Range("r2:r34")
If WorksheetFunction.CountBlank(emailRng) = emailRng.Cells.Count Then Exit Sub  'No data