如果找不到结果如何停止处理

Question

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

这些是账单日期，这意味着发票是在说的那一天生成的。

但是，当没有开具发票时，宏会冻结并花费很长时间，直到出现来自 VBA 的调试 window。我的目标是添加一行，显示一个消息框，上面写着“昨天没有生成发票”，并通过 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:

Answer 1

我将我推荐的 mod 添加到您的程序中并进行了测试。当您调用 .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

这是mod化代码：

    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

如果找不到结果如何停止处理

How to stop processing if no results found

excel

vba

filtering

filter