VBA代码警告过期物资援助

Question

我试图创建一个弹出窗口，只要我打开我的excel文件。

我拥有的excel工作簿有多个工作表。

其中一张纸的标题是“库存”。

如下图所示，在“库存”选项卡中有一列名为“直到终止日期”。

打开工作簿时，我想让excel文件弹出。此弹出窗口将检查“库存”选项卡中的“直到终止日期”列，并在"____材料“(从”类型“栏中)”有____“直到到期时这样说。

只有在“截止日期”值在0到14天之间时，才会发生这种情况。

如果数字是负数在“直到结束”栏，我希望消息弹出说"___材料已过期“。

下面显示的是我到目前为止的情况。我已经创建了一个workbook_open()事件，该代码位于我的"ThisWorkbook“代码选项卡中。

当我运行下面的内容时，我也会遇到一个错误，具体地说：

运行时错误“13”：类型不匹配

 Private Sub Workbook_Open()



Application.WindowState = xlMaximized

        Dim wb As Workbook
        Dim ws As Worksheet
        Dim rngUsed As Range, rngExpirationColumn As Range, rngCell As Range
        Dim strExpirationMessage As String

        Set wb = ThisWorkbook
        Set ws = wb.Sheets("Inventory")
        Set rngUsed = ws.UsedRange
        Set rngExpirationColumn = Intersect(ws.Columns(4), rngUsed)

        For Each rngCell In rngExpirationColumn.Cells
            If Date - CDate(rngCell.Value2) >= 14 Then
                If Len(strExpirationMessage) = 0 Then
                    strExpirationMessage = rngCell.Offset(0, -3).Value2 & " material has " & (Date - CDate(rngCell.Value2)) & " days left before expiration"
                Else
                    strExpirationMessage = strExpirationMessage & Chr(13) & rngCell.Offset(0, -3).Value2 & " material has " & (Date - CDate(rngCell.Value2)) & " days left before expiration"
                End If
            End If
        Next

        MsgBox strExpirationMessage

End Sub

​

​

Answer 1

我根据您的要求发布这个答案，并假设如下：

• 您希望检查列“直到终止日期”(根据您的请求)的数据。
• 您希望从"Type“列中获取数据，以便在弹出窗口中添加(根据您的请求)
• 如果终止日期介于0到14之间，您需要一条消息
• 如果终止天数小于0，则需要另一条消息。
• 列“直至终止日期”的值实际上是一个数字(这是一个假设，因为没有提供任何数据)。
• 我假设“Expiration的日子”被合并成两行(每个屏幕截图)
• 我假设您的数据就在屏幕截图中的行下面，所以您的实际数据可能从第4行开始

下面是代码(由于缺乏再现场景的实际数据)(基于上述假设进行测试)：

Private Sub Workbook_Open()

    Application.WindowState = xlMaximized

    Dim ws As Worksheet
    Dim strExpirationMessage As String
    Dim rngExpirationCell As Range, rngTypeCell As Range
    Dim lngRow As Long, lngExpirationCol As Long, lngTypeCol As Long

    Set ws = ThisWorkbook.Worksheets("Inventory")
    Set rngExpirationCell = ws.UsedRange.Find(What:="Days Until Expiration", LookAt:=xlWhole, MatchCase:=False, SearchFormat:=False)
    Set rngTypeCell = ws.UsedRange.Find(What:="Type", LookAt:=xlWhole, MatchCase:=False, SearchFormat:=False)

    If Not rngExpirationCell Is Nothing And Not rngTypeCell Is Nothing Then
        lngExpirationCol = rngExpirationCell.Column
        lngTypeCol = rngTypeCell.Column

        For lngRow = rngExpirationCell.row + 2 To ws.UsedRange.Rows.Count
            With ws.Cells(lngRow, lngExpirationCol)

                If 0 <= .Value And .Value <= 14 Then
                    strExpirationMessage = strExpirationMessage & ws.Cells(lngRow, lngTypeCol).Value & " material has " & .Value & " days left before expiration" & vbCrLf
                ElseIf .Value < 0 Then
                    strExpirationMessage = strExpirationMessage & ws.Cells(lngRow, lngTypeCol).Value & " material has expired" & vbCrLf
                End If

            End With
        Next

        strExpirationMessage = Left(strExpirationMessage, Len(strExpirationMessage) - 2) 'to remove trailing vbCrLf
        MsgBox strExpirationMessage

    End If

End Sub

重要注释：

• 我修改了你们逻辑的一部分，消除了一些变量，而使用了其他变量。
• 我不是在处理范围对象，而是处理指定的单元格。
• 我正在动态搜索所需的列“直到Expiration”和"Type"，而不是使用固定列和偏移量，以允许您在不更改代码的情况下更改列的位置。
• 我假设“Expiration的日子”合并成两行(每个屏幕截图)，这就是我在For循环中使用For的原因。如果您有任何不同的地方，代码可能需要更改。

我希望这能满足你的需要。让我知道任何问题或关切。如果这篇文章回答了你的问题，请点击左边的复选标记来接受它。

更新：

根据您发现的问题，下面是您可以使用的For循环的两种替代解决方案。其他的一切都应该完全一样。只需将For循环替换为下面的任何一个逻辑，就可以了。

假设您想在找到空单元格后离开逻辑：

For lngRow = rngExpirationCell.row + 2 To ws.UsedRange.Rows.Count
    With ws.Cells(lngRow, lngExpirationCol)
        If IsEmpty(.Value) Then Exit For    'Will leave the For loop once an Empty cell is found

        If 0 <= .Value And .Value <= 14 Then
            strExpirationMessage = strExpirationMessage & ws.Cells(lngRow, lngTypeCol).Value & " material has " & .Value & " days left before expiration" & vbCrLf
        ElseIf .Value < 0 Then
            strExpirationMessage = strExpirationMessage & ws.Cells(lngRow, lngTypeCol).Value & " material has expired" & vbCrLf
        End If

    End With
Next

假设您想跳过空单元格的计算，但继续检查单元格，直到使用范围结束为止：

For lngRow = rngExpirationCell.row + 2 To ws.UsedRange.Rows.Count
    With ws.Cells(lngRow, lngExpirationCol)
        If Not IsEmpty(.Value) Then    'Will skip empty cells but continuing validation until the end of the Used Range
            If 0 <= .Value And .Value <= 14 Then
                strExpirationMessage = strExpirationMessage & ws.Cells(lngRow, lngTypeCol).Value & " material has " & .Value & " days left before expiration" & vbCrLf
            ElseIf .Value < 0 Then
                strExpirationMessage = strExpirationMessage & ws.Cells(lngRow, lngTypeCol).Value & " material has expired" & vbCrLf
            End If
        End If

    End With
Next