MS excel宏自动计数功能，结果弹出窗口显示

Question

大家好，目前我仍然面临老板任务的问题，创建一个 MS excel 宏。

面临的问题还是一样：

• 自动统计过期数据并在用户打开工作表时显示在消息框中。

在上一个问题上，我已经问了一些解决方案，并将这些建议编码与我原来的编码结合起来，但结果也是一样的，即使有过期的员工合同，消息仍然弹出为 0。

以下是您的建议和我的原始编码的组合...请看一下。

以下是您的建议和我的原始编码的组合...请查看并随时发表评论，让我知道出了什么问题。我需要它尽快..

Sub Worksheet_Activate()

Dim startCell As Integer, endCell As Integer
Dim column As Integer
Dim CountCells As Integer
Dim x As Integer

With Worksheets("Sheet1")

lastrow = Range("L1048576").End(xlUp).Row



For i = 4 To lastrow

    If Range("L" & i).Value <> "" And Now <> "" Then

       If Range("L" & i).Value <= Now Then

           Range("L" & i).Font.ColorIndex = 3

        End If
    End If
Next i

    column = 12 'Column L

    startCell = 4
    endCell = xlUp

    CountCells = 0



    For x = startCell To endCell Step 1

    If Cells(x, column).Interior.ColorIndex = 3 Then

        CountCells = CountCells + 1 


    End If
Next x

    MsgBox CountCells & " expiring"

End With
End Sub

Answer 1

为什么不使用相同的lastrow 而不是创建endCell 这将确保代码在相同的值范围内运行。

您也可以将endCell 更改为

endCell = Range("L1048576").End(xlUp).Row

我认为 xlUp 本身不会起作用。

编辑：

Sub Worksheet_Activate()

Dim startCell As Integer, endCell As Integer
Dim column As Integer
Dim CountCells As Integer
Dim x As Integer
Dim lastrow As Integer
Dim i As Integer



With Worksheets("Sheet1")

lastrow = Range("L1048576").End(xlUp).Row



For i = 4 To lastrow

    If Range("L" & i).Value <> "" And Now <> "" Then

        If Range("L" & i).Value <= Now Then

            Range("L" & i).Interior.ColorIndex = 3

        End If
    End If
Next i

column = 12 'Column L

startCell = 4

CountCells = 0


For x = startCell To lastrow Step 1

    If Cells(x, column).Interior.ColorIndex = 3 Then

        CountCells = CountCells + 1

    End If

Next x

MsgBox CountCells & " expiring"

End With
End Sub

Answer 2

使用With...End With时，所有属于With子句的对象都应在前面加上.（句点）

例如

With Worksheets("Sheet1")
    lastrow = Range("L1048576").End(xlUp).Row

应该是

With Worksheets("Sheet1")
    lastrow = .Range("L1048576").End(xlUp).Row

进行修复，看看是否有帮助。如果仍然无法正常工作，请使用您当前的代码更新您的问题。

Answer 3

问题已解决，以下是正确/可用的编码。 谢谢大家，只有我能够继续测试和修改代码。

Sub Worksheet_Activate()

Dim startCell As Integer, endCell As Integer
Dim column As Integer
Dim CountCells As Integer
Dim x As Integer

With Worksheets("Sheet1")

lastrow = Range("L1048576").End(xlUp).Row

CountCells = 0

For i = 4 To lastrow

    If Range("L" & i).Value <> "" And Now <> "" Then

        If Range("L" & i).Value <= Now Then

            Range("L" & i).Font.ColorIndex = 3

                If Range("L" & i).Font.ColorIndex = 3 Then

                   CountCells = CountCells + 1

            End If
        End If
    End If
Next i

   MsgBox CountCells & " expiring"

End With
End Sub