在VBA中運行代碼時是否有跳過過濾掉的行的功能？

我開發了一個模板，可以通過輸出電子郵件自動進行發票提醒。目前，代碼回圈遍歷串列，為每個單獨的行（=每個單獨的發票）輸出一封電子郵件。我想更新代碼，以便它跳過 excel 檔案中過濾掉的行，使其更高效、更易于使用。

我的代碼如下：

Sub Send_email_fromtemplate()
Dim edress As String
Dim cc1, cc2, cc3 As String
Dim group As String
Dim number As String
Dim outlookapp As Object
Dim outlookmailitem As Object
Dim r As Long
Dim olInsp As Object
Dim wdDoc As Object
Dim oRng As Object

 r = 3

Do While Sheet1.Cells(r, 1) <> ""
    Set outlookapp = CreateObject("Outlook.Application")
    'call your template
    Set outlookmailitem = outlookapp.CreateItemFromTemplate([location])
    outlookmailitem.Display

    edress = Sheet1.Cells(r, 7)
    cc1 = Sheet1.Cells(r, 8)
    cc2 = Sheet1.Cells(r, 9)
    cc3 = Sheet1.Cells(r, 10)
    group = Sheet1.Cells(r, 4)
    number = Sheet1.Cells(r, 3).Value
    With outlookmailitem
       .To = edress
        .cc = cc1 & ";" & cc2 & ";" & cc3
        .bcc = ""
        .Subject = "First invoice reminder " & group
        
        Set olInsp = .GetInspector
        Set wdDoc = olInsp.WordEditor
        Set oRng = wdDoc.Range
        With oRng.Find
            Do While .Execute(FindText:="{{Number}}")
                oRng.Text = number
                Exit Do
            Loop
        End With
        Set xInspect = outlookmailitem.GetInspector
  
       .Display
        '.send
    End With
    'clear your email address
    edress = ""
    
    r = r   1
    
Loop
'clear your fields
Set outlookapp = Nothing
Set outlookmailitem = Nothing
Set wdDoc = Nothing
Set oRng = Nothing
End Sub

我嘗試使用 Range 函式和 ActiveSheet.UsedRange.SpecialCells(xlCellTypeVisible) 來解決問題，但是由于模板將填充可變數量的行（每次我發送提醒時），這會造成麻煩，因為范圍每次都不同。

uj5u.com熱心網友回復：

請嘗試下一個更新的代碼。正如我在上面的評論中所說，它能夠計算 A:A 上的最后一行，然后從過濾區域的可見行創建一個范圍并在其行之間迭代：

Sub Send_email_fromtemplate()
 Dim edress As String, cc1 As String, cc2 As String, cc3 As String
 Dim group As String, number As String
 Dim outlookapp As Object, outlookmailitem As Object, olInsp As Object
 Dim wdDoc As Object, xInspect As Object
 Dim oRng As Object, lastR As Long, rngVis As Range, r As Range

lastR = Sheet1.Range("A" & Sheet1.rows.count).End(xlUp).row 'last row on A:A
On Error Resume Next 'this is necessary in case of no any filtered visible cell
  Set rngVis = Sheet1.Range("A3:J" & lastR).SpecialCells(xlCellTypeVisible)
On Error GoTo 0
 If rngVis Is Nothing Then MsgBox "No visible filtered values in the necessary range...": Exit Sub

 Set outlookapp = CreateObject("Outlook.Application") 'you should set it only ones, outside of the iteration...
 For Each r In rngVis.rows 'iterate between the discontinuous (visible cells) rows
    'call your template
    Set outlookmailitem = outlookapp.CreateItemFromTemplate([Location])
    outlookmailitem.Display

    edress = r.cells(1, 7) 'extract the necessary values from the iterated row
    cc1 = r.cells(1, 8)
    cc2 = r.cells(1, 9)
    cc3 = r.cells(1, 10)
    group = r.cells(1, 4)
    number = r.cells(1, 3).Value
    With outlookmailitem
       .To = edress
        .cc = cc1 & ";" & cc2 & ";" & cc3
        .BCC = ""
        .Subject = "First invoice reminder " & group
        
        Set olInsp = .GetInspector
        Set wdDoc = olInsp.WordEditor
        Set oRng = wdDoc.Range
        With oRng.Find
            Do While .Execute(FindText:="{{Number}}")
                oRng.Text = number
                Exit Do
            Loop
        End With
        Set xInspect = outlookmailitem.GetInspector
  
       .Display
        '.send
    End With
    'clear your email address
    edress = ""
 Next r

 'clear memory of used objects:
 Set outlookapp = Nothing: Set outlookmailitem = Nothing
 Set wdDoc = Nothing: Set oRng = Nothing
End Sub

請在測驗后發送一些反饋。

標籤：擅长VBA过滤

上一篇：VBA在特定時間發送電子郵件-如何解決？

下一篇：獲取由Excel名稱管理器定義的特定單元格的“名稱”