如果没有找到结果如何停止处理

Question

我的脚本的这一部分对日期应用过滤器（在将它们从 SAP 导入的点转换为斜线之后），然后选择今天的前一天（昨天）。

这些是计费日期，表示发票是在当天生成的。

但是，当没有开票时，宏会冻结并需要很长时间才能出现来自 VBA 的调试窗口。我的目标是添加一行，显示一个 msgbox，上面写着“昨天没有生成发票”，然后通过 Outlook 将其发送给我的同事。

这是我的脚本：

Sub convertStringsToDate()
    
    Const wsName As String = "Sheet1"
    Const ColumnIndex As Variant = "G"
    Const FirstRow As Long = 2
    
    ' Define workbook.
    Dim wb As Workbook
    Set wb = Workbooks("Daily Invoiced ZAMSOTC02 LAC TEAM.xlsm") ' The workbook containing this code.
    
    ' Define worksheet.
    Dim ws As Worksheet
    Set ws = wb.Worksheets("Sheet 1")
    
    ' Turn off AutoFilter.
    If ws.AutoFilterMode Then
        ws.AutoFilterMode = False
    End If
    
    ' Define Column Range.
    Dim LastRow As Long
    LastRow = ws.Cells(ws.Rows.Count, ColumnIndex).End(xlUp).Row
    Dim rng As Range
    Set rng = ws.Range(ws.Cells(FirstRow, ColumnIndex), _
                       ws.Cells(LastRow, ColumnIndex))
    
    ' Write values from Column Range to Data Array.
    Dim Data As Variant
    If rng.Rows.Count > 1 Then
        Data = rng.Value
    Else
        ReDim Data(1 To 1, 1 To 1)
        Data(1, 1) = rng.Value
    End If
    
    ' Convert values in Data Array, converted to strings, to dates.
    Dim CurrentValue As Variant
    Dim i As Long
    For i = 1 To UBound(Data)
        CurrentValue = DotToSlashDate(CStr(Data(i, 1)))
        If Not IsEmpty(CurrentValue) Then
            Data(i, 1) = CurrentValue
        End If
    Next
    
    ' Write dates from Data Array to Column Range.
    rng.Value = Data
    
    ' Apply AutoFilter.
    ws.Range("A1").AutoFilter Field:=7, _
                              Operator:=xlFilterDynamic, _
                              Criteria1:=xlFilterYesterday
                              
End Sub

' Converts a string in the format of either d.m.yyyy or d.m.yyyy.
' to a date in the current Excel date format.
' If the string is not in the required format, it returns empty.
Function DotToSlashDate(DotDate As String) As Variant
    On Error GoTo ProcExit
    Dim fDot As Long
    fDot = InStr(1, DotDate, ".")
    Dim dDay As String
    dDay = Left(DotDate, fDot - 1)
    Dim sDot As Long
    sDot = InStr(fDot + 1, DotDate, ".")
    Dim mMonth As String
    mMonth = Mid(DotDate, fDot + 1, sDot - fDot - 1)
    Dim yYear As String
    yYear = Replace(Right(DotDate, Len(DotDate) - sDot), ".", "")
    DotToSlashDate = DateSerial(CLng(yYear), CLng(mMonth), CLng(dDay))
ProcExit:
End Function```

I have reviewed these answers and topics, but the solution eludes me:

https://stackoverflow.com/questions/46399362/vba-output-message-box-when-autofilter-returns-no-data

Answer 1

我将我推荐的模组添加到您的程序中并对其进行了测试。当您调用 .SpecialCells(xlCellTypeVisible).Rows.Count 并且没有单元格与过滤器匹配时，会引发错误。所以我在执行代码行之前添加了 On Error Resume Next，并添加了一个长整型变量来保存计数。如果没有匹配过滤器，则会忽略错误并且长整数等于 0，因为长整数默认初始化为零值。

另请注意，您的原始代码忽略了常量 [wsName]。我修复了它，所以如果您的工作表名称不是 Sheet1，那么您需要在常量定义中更正它：

Set ws = wb.Worksheets("Sheet 1") ' Original Code
Set ws = wb.Worksheets(wsName) ' Modified Code

这里是修改后的代码：

    Sub convertStringsToDate()
        
        Const wsName As String = "Sheet1"
        Const ColumnIndex As Variant = "G"
        Const FirstRow As Long = 2
    
        ' Define workbook.
        Dim wb As Workbook
        Set wb = Workbooks("Daily Invoiced ZAMSOTC02 LAC TEAM.xlsm") ' The workbook containing this code.
        
        ' Define worksheet.
        Dim ws As Worksheet
        Set ws = wb.Worksheets(wsName)
        
        ' Turn off AutoFilter.
        If ws.AutoFilterMode Then
            ws.AutoFilterMode = False
        End If
        
        ' Define Column Range.
        Dim LastRow As Long
        LastRow = ws.Cells(ws.Rows.Count, ColumnIndex).End(xlUp).Row
        Dim rng As Range
        Set rng = ws.Range(ws.Cells(FirstRow, ColumnIndex), _
                           ws.Cells(LastRow, ColumnIndex))
        
        ' Write values from Column Range to Data Array.
        Dim Data As Variant
        If rng.Rows.Count > 1 Then
            Data = rng.Value
        Else
            ReDim Data(1 To 1, 1 To 1)
            Data(1, 1) = rng.Value
        End If
        
        ' Convert values in Data Array, converted to strings, to dates.
        Dim CurrentValue As Variant
        Dim i As Long
        For i = 1 To UBound(Data)
            CurrentValue = DotToSlashDate(CStr(Data(i, 1)))
            If Not IsEmpty(CurrentValue) Then
                Data(i, 1) = CurrentValue
            End If
        Next
        
        ' Write dates from Data Array to Column Range.
        rng.Value = Data
        
        ' Apply AutoFilter.
        ws.Range("A1").AutoFilter Field:=7, _
                                  Operator:=xlFilterDynamic, _
                                  Criteria1:=xlFilterYesterday
        
    On Error Resume Next
        Dim xRows As Long
        xRows = rng.SpecialCells(xlCellTypeVisible).Rows.Count
        If xRows = 0 Then MsgBox "No Data in Sheet from date " & Date - 1
    ProcExit:
        'Remove Autofiltering
        If ws.AutoFilterMode Then
            ws.AutoFilterMode = False
        End If
    
    End Sub
    
    ' Converts a string in the format of either d.m.yyyy or d.m.yyyy.
    ' to a date in the current Excel date format.
    ' If the string is not in the required format, it returns empty.
Function DotToSlashDate(DotDate As String) As Variant
    On Error GoTo ProcErr
    Dim fDot As Long
    fDot = InStr(1, DotDate, ".")
    Dim dDay As String
    dDay = Left(DotDate, fDot - 1)
    Dim sDot As Long
    sDot = InStr(fDot + 1, DotDate, ".")
    Dim mMonth As String
    mMonth = Mid(DotDate, fDot + 1, sDot - fDot - 1)
    Dim yYear As String
    yYear = Replace(Right(DotDate, Len(DotDate) - sDot), ".", "")
    DotToSlashDate = DateSerial(CLng(yYear), CLng(mMonth), CLng(dDay))
ProcExit:
    Exit Function
    
ProcErr:
    Resume ProcExit
End Function