导致变量不传递给函数的逻辑

Question

我在获取要正确传递给函数的变量集时遇到问题。令人沮丧的是，直到昨天这段代码已经正常工作了 4 个月的每周使用。

以下是代码，删除了无助于解决此问题的代码的暗点和部分。

    Sub Combined_15_and_45()
    
    'Dim Iteration Variables
    'Dim tracking variables    
    'Dim range variables    
    'Dim Invoice Value Variables    
    'Dim Email body variables
    
    Set wb = ThisWorkbook
    Set WithTerms = Sheet4
    Set APEmail = Sheet7
    
        With wb
            With WithTerms
                lrow = .Cells(Rows.Count, 5).End(xlUp).Row
                elrow = Sheet7.Cells(Rows.Count, 1).End(xlUp).Row
                CalcDate = .Cells(1, 3).Value
                i = 1
                'loop through looking for times when cell above is different *Store i Instance
                'loop through looking for times when cell below is different *Store i as EndInstance
                'Specifically searching for changes in account number
                
                For i = 4 To lrow
                    h = i - 1
                    j = i + 1
                    
                        Set rng = .Cells(i, 5)
                        Set RngUp = .Cells(h, 5)
                        Set RngDwn = .Cells(j, 5)
                        
                        'this is where vendor account changes.
                        If rng.Value <> RngUp.Value Then
                            instance = i
                        End If
                        
                        'Check if invoice for the line is extreme past due *Store i as MaxOvrDue
                        If .Cells(i, 10).Value <= .Range("C1").Value - 45 Then
                                MaxOvrDue = i
                        End If
                        
                        'check if invoice for line is +15 day overdue, less than 45 * Store i as MidOvrDur
                        If .Cells(i, 10).Value <= .Range("C1").Value - 15 Then
                            If .Cells(i, 10).Value >= .Range("C1").Value - 44 Then
                                If MidOvrdue = 0 Then
                                    MidOvrdue = i
                                End If
                            End If
                        End If
                        
                        'Check if Invoice for line is 15+ days overdue (Minimum) *Store i as Ovrdue
                        If .Cells(i, 10).Value < .Range("C1").Value Then
                            If .Cells(i, 10).Value <= .Range("C1").Value - 14 Then
                                OvrDue = i
                            End If
                        End If
                        
                        'figure values for the totals of each section
                        If rng.Value <> RngDwn.Value Then
                            EndInstance = i
                            TotalOverdue = Application.WorksheetFunction.SumIfs(.Range("K:K"), .Range("E:E"), .Cells(instance, 5), .Range("J:J"), "<" & (.Range("c1") - 15))
                            XtrmOverdue = Application.WorksheetFunction.SumIfs(.Range("K:K"), .Range("E:E"), .Cells(instance, 5), .Range("J:J"), "<" & .Range("C1") - 44)
                            MidTotalOverdue = Application.WorksheetFunction.SumIfs(.Range("K:K"), .Range("E:E"), .Cells(instance, 5), .Range("J:J"), "<" & .Range("C1") - 15, .Range("J:J"), ">=" & .Range("C1") - 45)
                            
                            
                            
                            
                                If OvrDue = 0 And MaxOvrDue = 0 And MidOvrdue = 0 Then
                                    Else:
                                        'begin building Extremely Overdue Invoice Text
                                        If MaxOvrDue <> 0 And MidOvrdue = 0 Then
                                                                                                                                
                                            **Set XtrmTblRng = .Range(.Cells(instance, 7), .Cells(MaxOvrDue, 11))**
                                            
                                        End If
                                        
                                        If OvrDue <> 0 And MidOvrdue <> 0 Then
                                            If MaxOvrDue = 0 And OvrDue <= MidOvrdue Then
                                                
                                                **Set MidTblRng = .Range(.Cells(MidOvrdue, 7), .Cells(OvrDue, 11))**                                                
                                                'Begin building ONLY overdue email text
                                                    
                                                                           
                                                Else:
                                                'begin building segments to add to extreme overdue email
            
                                                    **Set XtrmComboTblRng = .Range(.Cells(instance, 7), .Cells(OvrDue, 11))**
                                                
                                            End If
                                        End If
                               
                                If OvrDue <> 0 Then
                                        'Generate the email
                                        With OutMail
                                            .To = eAddy
                                            
                                            'Figure out which email to send
                                            
                                            If MaxOvrDue <> 0 And MidTotalOverdue <> 0 Then
                                                .HTMLbody = StrBodyXtrm & RangetoHTML(XtrmComboTblRng, CalcDate) & ComboStrBody2 & StrBody4

                                                Else
                                                If MaxOvrDue <> 0 And MidOvrdue = 0 Then
                                                    .HTMLbody = StrBodyXtrm & RangetoHTML(XtrmTblRng, CalcDate) & StrBody2 & StrBody4

                                                Else:
                                                    .HTMLbody = StrBodyOverdue & RangetoHTML(MidTblRng, CalcDate) & StrBody3

                                                End If
                                            End If
                                            .display
                                        End With
                                        With Application
                                            .EnableEvents = True
                                            .ScreenUpdating = True
                                        End With
                                    End If
                                End If
                            'clear variables when changing vendor IDs
                        End If
                    Set rng = .Cells(j, 5)
                    Next i
                End With
            End With

End Sub

Function RangetoHTML(TblRng, CalcDate)

    Dim fso As Object
    Dim ts As Object
    Dim TempFile As String
    Dim TempWB As Workbook
    Dim tRow As Long
    Dim i As Long
    
    Dim CalcDate2 As Double
    Dim TempDate As Double
    
    
    TempFile = Environ$("temp") & "\" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"

    'Copy the range and create a new workbook to paste the data in. This is where I am getting errors all the sudden
    **TblRng.Copy**
'manipulate the data from table to fit needs and past into email.
End Function

本质上，这是尝试对一堆发票进行分类并确定要使用的电子邮件格式。 45 岁以上的发票 15-45 岁以上的发票 15-44 岁的发票 我遇到了一个问题，电子邮件确定应该使用与已构建以传递给函数的 TblRng 变量不同的电子邮件格式。我似乎找不到我的逻辑错误。

几天来，我一直在用头撞墙，试图解决这个问题，但没有运气。你能给予的任何帮助都会让你成为我眼中的英雄！

谢谢

Answer 1

你的逻辑问题在于这一行

If maxOvrDue = 0 And OvrDue <= midOvrDue Then

如果没有 >45 行 (maxOvrDue = 0)，则在第一次出现 >15 行时 midOvrDue 和 OvrDue 将是相同的。在随后 >15 行 OvrDue 将 大于midOvrDue。所以上面对 1 为真，对 2 或更多为假 44-15 范围内的行。如果有 2 个或更多，则默认的 Else 选项将是 Set XtrmComboTblRng 而不是 MidTblRng。

后来因为maxOvrDue = 0 电子邮件.HTMLbody 使用RangetoHTML(MidTblRng, CalcDate)。 补救办法就是使用If maxOvrDue = 0 Then。

您可以在与设置范围相同的逻辑中设置电子邮件类型，这样就不会发生不匹配的情况。这是一个如何做到这一点的例子

Option Explicit

Sub Combined_15_and_45()
    
    Dim WithTerms As Worksheet, APEMail As Worksheet
    Dim rng As Range, tblRng As Range
    Dim lrow As Long, elrow As Long, i As Long
    Dim instance As Long, maxOvrDue As Long, midOvrDue As Long
    Dim CalcDate As Date, DaysLate As Integer, EmailFormat As Integer
    Dim has45 As Boolean, has15 As Boolean
    Dim acc As String
    Dim TotalOverdue As Currency
    Dim XtrmOverdue As Currency, MidTotalOverdue As Currency
    
    Set APEMail = Sheet7
    elrow = APEMail.Cells(Rows.Count, 1).End(xlUp).row

    ' for debugging
    Dim fso, ts
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    ' scan down sheet
    Set WithTerms = Sheet4
    With WithTerms
        lrow = .Cells(Rows.Count, "E").End(xlUp).row 'Row E
        CalcDate = .Range("C1").Value
                
        For i = 4 To lrow
                     
            'this is where vendor account changes.
            Set rng = .Cells(i, 5) ' E Account
            If rng.Value <> rng.Offset(-1).Value Then
                acc = rng
                instance = i
                maxOvrDue = 0
                midOvrDue = 0
                XtrmOverdue = 0
                MidTotalOverdue = 0
            End If
                        
            ' check days overdue
            DaysLate = DateDiff("d", .Cells(i, "J").Value, CalcDate)
            If DaysLate >= 45 Then
                maxOvrDue = i
                XtrmOverdue = XtrmOverdue + .Cells(i, "K")
            ElseIf DaysLate >= 15 Then
                midOvrDue = i
                MidTotalOverdue = MidTotalOverdue + .Cells(i, "K")
            End If
           
            ' is this last for account
            If rng <> rng.Offset(1) Then
                                  
                TotalOverdue = XtrmOverdue + MidTotalOverdue
                Debug.Print vbCr & acc & " Total", XtrmOverdue, MidTotalOverdue, TotalOverdue
                has45 = maxOvrDue > 0
                has15 = midOvrDue > 0
               
                If has45 Or has15 Then
                    If has45 And has15 Then
                        EmailFormat = 1
                        Set tblRng = .Range(.Cells(instance, 7), .Cells(midOvrDue, 11))
                        Debug.Print "+45 and +15", tblRng.Address
                        ' begin building segments to add to extreme overdue email
                        
                    ElseIf has45 Then
                        EmailFormat = 2
                        Set tblRng = .Range(.Cells(instance, 7), .Cells(maxOvrDue, 11))
                        Debug.Print "+45 only", tblRng.Address
                        ' begin building Extremely Overdue Invoice Text

                    ElseIf has15 Then
                        EmailFormat = 3
                        Set tblRng = .Range(.Cells(instance, 7), .Cells(midOvrDue, 11))
                        Debug.Print "+15 only", tblRng.Address
                        ' begin building ONLY overdue email text
                    End If
            
                    ' select email format
                    Dim body As String
                    Select Case EmailFormat
                        Case 1
                            body = "strBodyXtrm" & RangetoHTML(tblRng, CalcDate) & "ComboStrBody2 & strBody4"
                        Case 2
                            body = "strBodyXtrm" & RangetoHTML(tblRng, CalcDate) & "strBody2 & strBody4"
                        Case 3
                            body = "strBodyOverdue" & RangetoHTML(tblRng, CalcDate) & "strBody3"
                    End Select

                    ' create html file for checking
                    Set ts = fso.createTextFile(ThisWorkbook.Path & "\" & acc & ".html", 1)
                    ts.write body
                    ts.Close

                    'Generate the email
                    'With outmail
                         '.To = eAddy
                         '.HTMLbody = body
                         '.display
                    'End with
                End If
            End If
        Next i
    End With
    MsgBox "Done"
End Sub

Function RangetoHTML(tblRng, CalcDate) As String

    Dim s, rw As Range, cell As Range, pre As String
    pre = "<pre>TblRng=" & tblRng.Address(External:=1) & "</pre>"

    s = "<tr align=""center"" bgcolor=""#ddddff"">" & _
        "<th>Col G</th><th>Col H</th><th>Col I</th>" & _
        "<th>Col J</th><th>Col K</th></tr>" & vbCrLf

    For Each rw In tblRng.Rows
       s = s & "<tr>"
       For Each cell In rw.Cells
          s = s & "<td>" & cell & "</td>"
       Next
       s = s & "</tr>" & vbCrLf
    Next
    RangetoHTML = pre & "<table cellspacing=""0"" cellpadding=""3"" border=""1"">" & _
                  s & "</table>" & vbCrLf

End Function